Nhờ anh chị giúp đỡ Code vòng lặp copy dữ liệu qua nhiều sheet

[kientung]

Em chào tất cả mọi người ạ.
Hiện tại e có 1 file dữ liệu tổng nhưng muốn chia ra thành nhiều sheet.
Sau khi tính tổng số sheet cần chia thì sẽ chia sheet và đặt tên theo thứ tự ở cột O.

Sau khi chia sheet xong thì e muốn copy cả tên Lot Nhật ( Cột M sheet Data ) qua tầng sheet đã chia.
Copy tên Lot Nhật thứ tự qua sheet ( esd1,esd2,esd3,esd4) cột C6,C30,... tới C876 ( step=30 )
Sau khi copy tối đa 30 tên Lot Nhật sẽ chuyển qua sheet tiếp theo. ( 1 sheet sẽ chứa tối đa được 30 tên Lot Nhật )

Mong được sự giúp đỡ của mọi người ạ.

 

[Phuocam]

Em chào tất cả mọi người ạ.
Hiện tại e có 1 file dữ liệu tổng nhưng muốn chia ra thành nhiều sheet.
Sau khi tính tổng số sheet cần chia thì sẽ chia sheet và đặt tên theo thứ tự ở cột O.

Sau khi chia sheet xong thì e muốn copy cả tên Lot Nhật ( Cột M sheet Data ) qua tầng sheet đã chia.
Copy tên Lot Nhật thứ tự qua sheet ( esd1,esd2,esd3,esd4) cột C6,C30,... tới C876 ( step=30 )
Sau khi copy tối đa 30 tên Lot Nhật sẽ chuyển qua sheet tiếp theo. ( 1 sheet sẽ chứa tối đa được 30 tên Lot Nhật )

Mong được sự giúp đỡ của mọi người ạ.

Bạn chỉ copy cột M hay copy từ cột A đến M?

 

[kientung]

Bạn chỉ copy cột M hay copy từ cột A đến M?

Dạ em chỉ cần cột M thôi ạ.
Các cột khác e để công thức nó nhảy cũng được a ạ.

 

[Phuocam]

Code này copy 13 cột, bạn sửa lại nó theo ý bạn.

Public Sub TachSheet()
Dim i As Long, lastRow As Long
Dim sheetName  As String, k As Long
Dim ws As Worksheet
With Sheets("data")
    lastRow = .Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow Step 30
        k = k + 1
        sheetName = "esd" & k
        Sheets.Add After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = sheetName
       .Range("A1:M1").Copy ws.Range("A1")
       .Range("A" & i).Resize(30, 13).Copy ws.Range("A2")
       ws.UsedRange.EntireColumn.AutoFit
    Next
End With
End Sub

 

[kientung]

e cả

Code này copy 13 cột, bạn sửa lại nó theo ý bạn.

Public Sub TachSheet()
Dim i As Long, lastRow As Long
Dim sheetName  As String, k As Long
Dim ws As Worksheet
With Sheets("data")
    lastRow = .Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow Step 30
        k = k + 1
        sheetName = "esd" & k
        Sheets.Add After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = sheetName
       .Range("A1:M1").Copy ws.Range("A1")
       .Range("A" & i).Resize(30, 13).Copy ws.Range("A2")
       ws.UsedRange.EntireColumn.AutoFit
    Next
End With
End Sub

Em cảm ơn anh ạ

Sheet e muốn tách là sheet 『mau』 còn về phần dữ liệu thì sẽ lấy từ sheet 『Data』ạ

 

[Phuocam]

Sheet e muốn tách là sheet 『mau』 còn về phần dữ liệu thì sẽ lấy từ sheet 『Data』ạ

Code chưa bẫy lỗi:

Public Sub TachSheet2()
Dim i As Long, j As Long, lastRow As Long
Dim sheetName  As String, k As Long, kLot As Long
kLot = 1
Dim ws As Worksheet
With Sheets("data")
    lastRow = .Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow Step 30
        k = k + 1
        sheetName = "esd" & k
        Sheets("mau").Copy After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = sheetName
       For j = 6 To 30 * 30 + 6 Step 30
            kLot = kLot + 1
            If .Range("M" & kLot).Value = "" Then Exit For
            .Range("M" & kLot).Copy ws.Range("C" & j)
       Next j
       
    Next
End With
End Sub

 

[kientung]

Code chưa bẫy lỗi:

Public Sub TachSheet2()
Dim i As Long, j As Long, lastRow As Long
Dim sheetName  As String, k As Long, kLot As Long
kLot = 1
Dim ws As Worksheet
With Sheets("data")
    lastRow = .Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow Step 30
        k = k + 1
        sheetName = "esd" & k
        Sheets("mau").Copy After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = sheetName
       For j = 6 To 30 * 30 + 6 Step 30
            kLot = kLot + 1
            If .Range("M" & kLot).Value = "" Then Exit For
            .Range("M" & kLot).Copy ws.Range("C" & j)
       Next j
      
    Next
End With
End Sub

Em cảm ơn anh nhiều ạ.

 

[kientung]

Code chưa bẫy lỗi:

Public Sub TachSheet2()
Dim i As Long, j As Long, lastRow As Long
Dim sheetName  As String, k As Long, kLot As Long
kLot = 1
Dim ws As Worksheet
With Sheets("data")
    lastRow = .Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow Step 30
        k = k + 1
        sheetName = "esd" & k
        Sheets("mau").Copy After:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = sheetName
       For j = 6 To 30 * 30 + 6 Step 30
            kLot = kLot + 1
            If .Range("M" & kLot).Value = "" Then Exit For
            .Range("M" & kLot).Copy ws.Range("C" & j)
       Next j
      
    Next
End With
End Sub

Chào anh @phuocam
Sau khi nhận được sự giúp đỡ của anh thì em đã thêm code bẫy lỗi và code để copy từ cột A tới cột M của sheet Data qua được rồi.
Nhưng file có vẻ chạy hơi chậm vì chứa nhiều công thức quá.

Anh cho em hỏi có cách nào cải tiến để file chạy nhanh hơn được không ạ