Tách một sheet thành nhiều Sheet (1 người xem)

[quoccuonghd]

Tôi có một File biên bản Excel có 3 sheet. Nay nhờ các anh chị trên diễn đàn viết giúp tôi đoạn code với ý như sau: tách sheet BBNT A-B thành các sheet con lấy tên sheet mới theo số thứ tự tại ô V2 . nhưng tên sheet mới có thêm từ NTCV_ vào trước số thứ tự (ví dụ số thứ tự tại ô V2 là 1 thì tên của sheet mới là NTCV_1). Rất mong các anh chị viết giúp đoạn code này. Xin cảm ơn!
File đính kèm: http://www.mediafire.com/file/cjnx9p72qm1f047/BB_NTCV.xls
Tôi ko tải được file lên từ diễn đàn lên đành gủi qua mediafỉe.

 

[quoccuonghd]

Tôi có một File biên bản Excel có 3 sheet. Nay nhờ các anh chị trên diễn đàn viết giúp tôi đoạn code với ý như sau: tách sheet BBNT A-B thành các sheet con lấy tên sheet mới theo số thứ tự tại ô V2 . nhưng tên sheet mới có thêm từ NTCV_ vào trước số thứ tự (ví dụ số thứ tự tại ô V2 là 1 thì tên của sheet mới là NTCV_1). Rất mong các anh chị viết giúp đoạn code này. Xin cảm ơn!
File đính kèm: http://www.mediafire.com/file/cjnx9p72qm1f047/BB_NTCV.xls
Tôi ko tải được file lên từ diễn đàn lên đành gủi qua mediafỉe.

Có anh chị nào giúp tôi trả lời đề tài này với

 

[giaiphap]

Tôi có một File biên bản Excel có 3 sheet. Nay nhờ các anh chị trên diễn đàn viết giúp tôi đoạn code với ý như sau: tách sheet BBNT A-B thành các sheet con lấy tên sheet mới theo số thứ tự tại ô V2 . nhưng tên sheet mới có thêm từ NTCV_ vào trước số thứ tự (ví dụ số thứ tự tại ô V2 là 1 thì tên của sheet mới là NTCV_1). Rất mong các anh chị viết giúp đoạn code này. Xin cảm ơn!
File đính kèm: http://www.mediafire.com/file/cjnx9p72qm1f047/BB_NTCV.xls
Tôi ko tải được file lên từ diễn đàn lên đành gủi qua mediafỉe.

Bạn sử dụng đoạn code này thử xem.

Public Sub GPE()
Dim so As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
    so = Sheet3.Range("A65000").End(xlUp)
    For i = 1 To so
        Sheet6.Range("V2").Value = i
        Sheet6.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
        Cells.Copy
        Sheets(ThisWorkbook.Sheets.Count).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets(ThisWorkbook.Sheets.Count).Name = "BBNT_" & i
    Next i
    Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationManual
End Sub

 

[quoccuonghd]

Bạn sử dụng đoạn code này thử xem.

Public Sub GPE()
Dim so As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
    so = Sheet3.Range("A65000").End(xlUp)
    For i = 1 To so
        Sheet6.Range("V2").Value = i
        Sheet6.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
        Cells.Copy
        Sheets(ThisWorkbook.Sheets.Count).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets(ThisWorkbook.Sheets.Count).Name = "BBNT_" & i
    Next i
    Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationManual
End Sub

Cảm ơn bạn đã trợ giúp đoạn code này. mình đã chạy thủ đoạn code này trên excel 2010 thì ok ko bị lỗi. nhưng khi chạy trên excel 2003 thi bị báo lỗi như hình đính kèm. mình nhờ bạn khác phục giúp lỗi này và có thêm một mong muốn nữa là mình muốn tất các sheet trích ra từ sheet nguồn đó đó xuất hẳn ra một file excel mới (lý do là file excel gốc của mình hiện có rất nhiều các sheet khác nữa lúc gửi File đính kèm lên diễn đàn là mình đã xóa hết các sheet khac đi cho nhẹ file). cảm ơn bạn nhiều.

 

[nmhung49]

Cảm ơn bạn đã trợ giúp đoạn code này. mình đã chạy thủ đoạn code này trên excel 2010 thì ok ko bị lỗi. nhưng khi chạy trên excel 2003 thi bị báo lỗi như hình đính kèm. mình nhờ bạn khác phục giúp lỗi này và có thêm một mong muốn nữa là mình muốn tất các sheet trích ra từ sheet nguồn đó đó xuất hẳn ra một file excel mới (lý do là file excel gốc của mình hiện có rất nhiều các sheet khác nữa lúc gửi File đính kèm lên diễn đàn là mình đã xóa hết các sheet khac đi cho nhẹ file). cảm ơn bạn nhiều.

Sử dụng code này

[GPECODE=vb]
Public Sub NTCV()
Dim So As Long, i As Long
Dim KQ, SheetName As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationAutomatic
So = Sheet3.Range("A65000").End(xlUp)
For i = 1 To 2
SheetName = "NTCV_" & i
With Sheet6
.Range("V2").Value = i
.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
End With
With Sheets(ThisWorkbook.Sheets.Count)
KQ = .UsedRange.Value
.UsedRange.Value = KQ
.Name = SheetName
.Move
End With
ActiveWorkbook.Close True, ThisWorkbook.Path & "" & SheetName
Next i
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationManual
End With
End Sub


[/GPECODE]

 

[quoccuonghd]

Sử dụng code này

[GPECODE=vb]
Public Sub NTCV()
Dim So As Long, i As Long
Dim KQ, SheetName As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationAutomatic
So = Sheet3.Range("A65000").End(xlUp)
For i = 1 To 2
SheetName = "NTCV_" & i
With Sheet6
.Range("V2").Value = i
.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
End With
With Sheets(ThisWorkbook.Sheets.Count)
KQ = .UsedRange.Value
.UsedRange.Value = KQ
.Name = SheetName
.Move
End With
ActiveWorkbook.Close True, ThisWorkbook.Path & "" & SheetName
Next i
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationManual
End With
End Sub


[/GPECODE]

Cảm ơn bạn đã trợ giúp. Đoạn code này của bạn có xuất riêng sheet ra một flie mới nhưng lại chỉ xuất được có một sheet. mình muốn xuất toàn bộ ra các sheet nhu code của bạn giaiphap và tất cả các sheet đó xuất gộp vào một file mới. mong bạn và mọi người trên diễn đàn trợ giúp. Xin cảm ơn

 

[quoccuonghd]

Nhờ mọi người trên diễn đàn trợ giúp tôi hoàn thiện code cho đề tài này với.

 

[giaiphap]

Cảm ơn bạn đã trợ giúp. Đoạn code này của bạn có xuất riêng sheet ra một flie mới nhưng lại chỉ xuất được có một sheet. mình muốn xuất toàn bộ ra các sheet nhu code của bạn giaiphap và tất cả các sheet đó xuất gộp vào một file mới. mong bạn và mọi người trên diễn đàn trợ giúp. Xin cảm ơn

Vậy bạn sử dụng code này thử xem.

Public Sub GPE()
Dim so As Long, i As Long, s() As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
    so = Sheet3.Range("A65000").End(xlUp)
    ReDim s(1 To so)
    For i = 1 To so
        Sheet6.Range("V2").Value = i
        Sheet6.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
        Cells.Copy
        Sheets(ThisWorkbook.Sheets.Count).Range("A1").PasteSpecial Paste:=xlPasteValues
        Sheets(ThisWorkbook.Sheets.Count).Name = "BBNT_" & i
        s(i) = ThisWorkbook.Sheets.Count
    Next i
    Application.CutCopyMode = False
Sheets(s).Move
'Dat ten tai dong duoi neu muon luu file, neu khong luu thi bo dong duoi
ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & "TenFile.xls"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationManual
End Sub

 

[quoccuonghd]

Vậy bạn sử dụng code này thử xem.

Public Sub GPE()
Dim so As Long, i As Long, s() As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
    so = Sheet3.Range("A65000").End(xlUp)
    ReDim s(1 To so)
    For i = 1 To so
        Sheet6.Range("V2").Value = i
        Sheet6.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
        Cells.Copy
        Sheets(ThisWorkbook.Sheets.Count).Range("A1").PasteSpecial Paste:=xlPasteValues
        Sheets(ThisWorkbook.Sheets.Count).Name = "BBNT_" & i
        s(i) = ThisWorkbook.Sheets.Count
    Next i
    Application.CutCopyMode = False
Sheets(s).Move
'Dat ten tai dong duoi neu muon luu file, neu khong luu thi bo dong duoi
ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & "TenFile.xls"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationManual
End Sub

ok CHUẨN RỒI. ĐÚNG Ý CỦA MÌNH RỒI. CẢM ƠN BẠN RẤT NHIỀU.

 

[nmhung49]

Cảm ơn bạn đã trợ giúp. Đoạn code này của bạn có xuất riêng sheet ra một flie mới nhưng lại chỉ xuất được có một sheet. mình muốn xuất toàn bộ ra các sheet nhu code của bạn giaiphap và tất cả các sheet đó xuất gộp vào một file mới. mong bạn và mọi người trên diễn đàn trợ giúp. Xin cảm ơn

Do lúc kiểm tra thử chỉ thử 2 file mà chưa sửa lại vòng lặp bạn sửa chỗ này

For i = 1 To 2

Thành

For i = 1 To So

 

[quoccuonghd]

Do lúc kiểm tra thử chỉ thử 2 file mà chưa sửa lại vòng lặp bạn sửa chỗ này

Thành

Cảm ơn bạn đã giúp, mình đã thay vào để chạy thử thì thấy code của bạn có tách ra thành các sheet và mỗi một sheet này lại thành một file mới và các file mới này lại bay ra khỏi thư mục chứa file nguồn. Mà ý của mình thì lại muốn các sheet sau khi tách ra lại gộp vào 1 file duy nhất nằm luôn trong thư mục chứa file ngốc và đề tài này đã được bạn "giaiphap" giúp đúng ý của mình rồi. Dù sao cũng rất cấm ơn bạn đã dành thời gian để trợ giúp mình đoạn code trên.