Tạo code tách thông tin bộ phận (1 người xem)

[yoomi]

Các bạn giúp mình tách file tổng hợp thành các file khác nhau theo tên bộ phận trong file tổng hợp.
Cảm ơn.

 

[yoomi]

Tách từ file này thành nhiều file khác nhau theo bộ phận??? Hay là tách từ sheet này thành nhiều sheet theo bộ phận trên file này luôn...

Hỏi cho rõ không mất công mần rồi mần lại oải lắm!!!

Tách từ file này thành nhiều file khác nhau theo bộ phận bạn ơi.

 

[yoomi]

Public Sub GPE()
Dim I As Long, Arr, Path As String, NewWb, Wb
Dim Dic, Tem As String, Bp As String, Rng As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set Wb = ActiveWorkbook
Path = ThisWorkbook.Path
With Wb.Sheets(1)
Set Rng = .Range("A3", .[A65000].End(3)).Resize(, 16)
Set Dic = CreateObject("scripting.dictionary")
Arr = .Range("B4", .[B65000].End(3)).Value
    For I = 1 To UBound(Arr)
        Tem = Arr(I, 1)
        If Tem <> Empty And Not Dic.exists(Tem) Then
            Dic.Add Tem, ""
            Bp = Tem
            Set NewWb = Workbooks.Add
            Rng.AutoFilter 2, Bp
            .Range("A1", Rng).SpecialCells(12).Copy
            With NewWb
                .Sheets(1).[A1].PasteSpecial xlPasteValues
                .Sheets(1).[A1].PasteSpecial xlPasteFormats
                .Sheets(1).Columns("A").Resize(, 16).AutoFit
                .Sheets(1).Name = Bp
                .SaveAs Filename:=Path & "\" & Bp & ".xlsx"
                .Close True
            End With
         End If
    Next I
        .Activate
        .AutoFilterMode = False
End With
Application.CutCopyMode = False
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub

Bạn ơi, chỉ giúp mình làm sao để tách được file, mình đã coppy code vào nhưng không biết bước tiếp theo.