Tách 1 file thành nhiều file có điều kiện

Chia sẻ bởi:hands

★★★★★

‹ Tổng Hợp Dữ Liệu Xin giúp trích xuất dữ liệu cột... ›

Quảng cáo

Chào anh/chị.

Em có file excel. Trong file có cột CI có 12 nhân viên. Nhờ anh/chị hướng dẫn giúp em cách tách file ra thành 12 file (mỗi nhân viên là 1 file, có thể lưu .xls hoặc xlsx nhưng vẫn giữ format cũ, có thể chọn đường dẫn lưu hoặc lưu mặc định vào file gốc cần tách, tên file lấy theo cột CJ, tên sheet lấy theo tên Sale trong cột CI).

Cám ơn anh/chị.

Bạn chạy code sau:

Option Explicit

Sub GPE()
Dim Dic As Object, Tmp As String, Sa
Dim I As Long, J As Long, K As Long, ShSum As Worksheet
Dim Arr, dArr, Rng As Range, Sh
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Arr = Sheet1.Range(Sheet1.[CI2], Sheet1.[CI65000].End(3))
ReDim dArr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
Set Dic = CreateObject("Scripting.Dictionary")
With Dic
    For I = 1 To UBound(Arr, 1)
    Tmp = Arr(I, 1)
        If Not .Exists(Tmp) Then
            K = K + 1
            .Add Tmp, K
            For J = 1 To UBound(Arr, 2)
                dArr(K, J) = Arr(I, 1)
            Next J
        End If
    Next I
End With
    Sheet1.Range("CK2").Resize(K, UBound(Arr, 2)) = dArr
On Error Resume Next
Set ShSum = ThisWorkbook.Sheets("Sum")
Set Rng = ShSum.Range(ShSum.[A1], ShSum.[A65000].End(3)).Resize(, 88)
ShSum.AutoFilterMode = False
For Each Sa In ShSum.Range("CK2:CK" & ShSum.[CK65000].End(3).Row)
    With Workbooks.Add
        Set Sh = .Sheets(1)
        Sh.Name = Sa
        Rng.AutoFilter 87, Sa
        ShSum.Range(ShSum.Range("A1"), Rng).SpecialCells(12).Copy
        Sh.Range("A1").PasteSpecial 8
        Sh.Range("A1").PasteSpecial
        Rng.AutoFilter
        .Close True, ThisWorkbook.Path & "" & Sa & ".xlsx"
    End With
Next Sa
        Sheet1.Range("CK2:CK65000").ClearContents
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Anh xem lại giúp em khi xuất ra thì dữ liệu cột CI bị xóa hết (anh giữ lại dữ liệu cột CI giúp em). Khi xuất thì em thấy có phát sinh cột CK (tổng hợp lại danh sách 12 nhân viên, cột này em không cần thiết). Tên file cũng lấy theo cột CI chứ chưa lấy theo cột CJ (do 2 cột của em trùng tên nên nó đúng, nếu em đổi tên cột CJ thì không đúng).
Cám ơn anh.