Cần giúp đỡ macro về xuất file theo từng đơn vị (1 người xem)

[nqt76]

Tôi cần lọc theo danh sách đơn vị (cột O), đối với mỗi đơn vị thì xuất ra 1 file có tên tương ứng với tên đơn vị đó.
Bạn nào giúp mình cái code với.
Xin cảm ơn.

 

[befaint]

Tôi cần lọc theo danh sách đơn vị (cột O), đối với mỗi đơn vị thì xuất ra 1 file có tên tương ứng với tên đơn vị đó.
Bạn nào giúp mình cái code với.
Xin cảm ơn.

1/ File không mở được vì cái "đuôi" của nó phải là .xls (Sao mình đổi thành *.xlsx vậy ta?)

2/ Có 5 sheets thì mình cần làm với sheet nào? Sao mình tô màu gì mà kinh dzậy???

 

[nqt76]

ồ, xin lỗi mọi người, sheet mình cần trích dữ liệu là sheet "LOAI 1". Mình gửi lại file đuôi .xls

 

[nhnn1986]

Bạn thử file sau, mình lưu file của bạn thành .xlsm và thêm Sheet("Main") để chay Macro.

Sau khi chạy nó sẽ tạo 1 sheet("log") để biết vị trí các file vừa lọc.

 

[nqt76]

Bạn thử file sau, mình lưu file của bạn thành .xlsm và thêm Sheet("Main") để chay Macro.

Sau khi chạy nó sẽ tạo 1 sheet("log") để biết vị trí các file vừa lọc.

Cám ơn bạn nhnn1986 rất nhiều. Mình đã nhận được file và chạy thử thì thấy có vấn đề như sau:
- Sau khi chạy xong, mình mở các file được copy ra xem thì thấy file đầu tiên thì ok, các file sau thì đều bị copy 1 dòng thứ 2 của file nguồn vào file đó. (Mình đình kèm file được copy ra để bạn xem)
- Một vấn đế khác nữa: đây là file được xuất ra từ 1 chương trình khác. Vậy mỗi lần 1 file nguồn này xuất ra, mình sẽ phải thêm sheet("Main") để chạy macro của bạn?

 

[nqt76]

Public Sub GPE()
Dim Dic As Object, Tmp As String, Arr, Path, Rng As Range
Dim WbMain As Workbook, Ws As Worksheet, I As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = 1
Set WbMain = ThisWorkbook: Path = WbMain.Path
Set Ws = WbMain.Sheets("LOAI 1")
Set Rng = Ws.Range("A1").CurrentRegion
Arr = Rng.Value
Set Dic = CreateObject("Scripting.Dictionary")
    For I = 2 To UBound(Arr)
        If Arr(I, 15) <> Empty Then
            Tmp = Arr(I, 15)
            If Not Dic.Exists(Tmp) Then
                Dic.Add Tmp, ""
                With Workbooks.Add
                    Rng.AutoFilter 15, Tmp
                    Ws.Range("A1", Rng).SpecialCells(12).Copy
                    .Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
                    .Sheets(1).Range("A1").PasteSpecial xlPasteValues
                    .Sheets(1).Range("A1").PasteSpecial xlPasteFormats
                    .Close True, Path & "\" & Tmp & ".xls"
                End With
            End If
        End If
    Next
Ws.AutoFilterMode = False
Set Dic = Nothing
MsgBox "Done!"
Application.SheetsInNewWorkbook = 3
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

cám ơn bạn hpkhuong nhé. Mình đã test xong, chạy rất ok.

 

[NguyenNgocThuHien]

Public Sub GPE()
Dim Dic As Object, Tmp As String, Arr, Path, Rng As Range
Dim WbMain As Workbook, Ws As Worksheet, I As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = 1
Set WbMain = ThisWorkbook: Path = WbMain.Path
Set Ws = WbMain.Sheets("LOAI 1")
Set Rng = Ws.Range("A1").CurrentRegion
Arr = Rng.Value
Set Dic = CreateObject("Scripting.Dictionary")
    For I = 2 To UBound(Arr)
        If Arr(I, 15) <> Empty Then
            Tmp = Arr(I, 15)
            If Not Dic.Exists(Tmp) Then
                Dic.Add Tmp, ""
                With Workbooks.Add
                    Rng.AutoFilter 15, Tmp
                    Ws.Range("A1", Rng).SpecialCells(12).Copy
                    .Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
                    .Sheets(1).Range("A1").PasteSpecial xlPasteValues
                    .Sheets(1).Range("A1").PasteSpecial xlPasteFormats
                    .Close True, Path & "\" & Tmp & ".xls"
                End With
            End If
        End If
    Next
Ws.AutoFilterMode = False
Set Dic = Nothing
MsgBox "Done!"
Application.SheetsInNewWorkbook = 3
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

eo! sao anh không sort dữ liệu cho nhanh, khi đó không cần dic, không cần autofilter. chỉ cần duyệt mảng đếm phần tử là có thể xuất dữ liệu rồi. Bạn ý kêu là còn nhiều file sẽ xuất từ phần mềm trong tương lai nữa. Vậy có nên chăng chơi kiểu macro viết trên một file, khi cần tách thì mở file cần tách. chạy macro thì cho phép người dùng bấm chuột vào sheet cần tách. Hoặc một cách tương tự nào đó.