Help me!!!Tách dữ liệu file excel vẫn giữ nguyên số lượng các sheet trong file tách (1 người xem)

[hang.nga]

Em chào các anh/chị

Em đang có bài toán như thế này, em cần nhờ anh chị giúp đỡ ạ:

Em có 1 file có nhiều sheet (các sheet có số lượng cột như nhau,chỉ khác nhau về số lượng dòng), em muốn tách file này ra các file khác mà số lượng sheet, tên sheet vẫn giữ nguyên, dữ liệu được tách theo cột "Field 6" tại tất cả các sheet, Tên file được tách lấy theo từng tên trong cột "Field 6"

Em gửi các anh chị/chị file cần tách. Mong các anh chị chỉ giáo và giúp đỡ em, em mới được biết tới VBA nên rất gà aj

Em cảm ơn anh/chị nhiều

 

[hang.nga]

em có code tách file có 4 sheet thành các file khác vẫn giữ nguyên các sheet như sau, em muốn sửa code để tách file có 18 sheet nhưng sửa không được. Các bác sửa giúp em với ạ (em gửi file cho các bác dễ hình dung)

Sub TachCN()


Workbooks("CHAY LOC VN.xlsm").Activate
c = Range("b1048576").End(xlUp).Row
ReDim arr(c - 2)
For i = 2 To c

If Range("B" & i).Value <> "" Then
arr(i - 2) = Range("B" & i).Value
End If
Next i


For k = 0 To UBound(arr)
CN = arr(k)

With Workbooks.Add
.Sheets.Add
.SaveAs ThisWorkbook.Path & "\" & CN & ".xlsx"
End With

For j = 1 To 4

Workbooks("Phan_tich_NV.xlsx").Sheets(j).Activate

dongcuoi = Range("a1048576").End(xlUp).Row

Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter

Workbooks("Phan_tich_NV.xlsx").Sheets(j).Activate
Range("A1").Select
ActiveSheet.Range("$A$1:$K$" & dongcuoi).AutoFilter Field:=11, Criteria1:=CN
dongcuoi4 = Range("b1048576").End(xlUp).Row
Range("A1:K" & dongcuoi4 + 2).Copy

Workbooks(CN & ".xlsx").Sheets(j).Activate
Range("A1").Select
Range("A1").PasteSpecial xlPasteValues
Workbooks(CN & ".xlsx").Sheets(j).Name = Workbooks("Phan_tich_NV.xlsx").Sheets(j).Name

Workbooks("Phan_tich_NV.xlsx").Sheets(j).Activate
Range("A1").Select
ActiveSheet.Range("$A$1:$H$" & dongcuoi).AutoFilter Field:=1
Next
Workbooks(CN & ".xlsx").Close True

Next
End Sub

Em cảm ơn các bác nhiều