Tách dữ liệu ra nhiều file

[tuanxitin]

Dear anh/chị cao nhân,

nhờ anh/chị xem giúp em file bị lỗi gì đính kèm giúp em
Em có 1 file tổng gồm nhiều đơn vị, mỗi đơn vị có nhiều dòng khác nhau, từ file tổng đó, e tách ra mỗi đơn vị là 1 file excel, với tên file là tên đơn vị đó.
Em viết code k biết lỗi gì mà k chạy được
nhờ anh/chị xem giúp em

Cảm ơn anh/chị

 

[Phuocam]

Dear anh/chị cao nhân,

nhờ anh/chị xem giúp em file bị lỗi gì đính kèm giúp em
Em có 1 file tổng gồm nhiều đơn vị, mỗi đơn vị có nhiều dòng khác nhau,
từ file tổng đó, e tách ra mỗi đơn vị là 1 file excel, với tên file là tên đơn vị đó.
Em viết code k biết lỗi gì mà k chạy được
nhờ anh/chị xem giúp em

Cảm ơn anh/chị

Mã trong file là: Sub tach_sheet_TH_thanh_nhieu_sheet()
Bạn viết mã "Tách sheet" hay "Tách file"?

 

[tuanxitin]

Mã trong file là: Sub tach_sheet_TH_thanh_nhieu_sheet()
Bạn viết mã "Tách sheet" hay "Tách file"?

em viết 2 mã anh: em cho nó chạy tách thành sheet rồi sau đó chạy tách ra file ạ

 

[Phuocam]

em viết 2 mã anh: em cho nó chạy tách thành sheet rồi sau đó chạy tách ra file ạ

Tách sheet lỗi tùm lum, sao tách file được?

 

[tuanxitin]

em mới tập tành viết code, nên mới nhờ anh/chị cao nhân hỗ trợ giúp em.
Anh xem fix lỗi giúp em được không ạ

 

[Phuocam]

Thử code này:

Sub tach_sheet_TH_thanh_nhieu_sheet()

    Dim lr As Long
    Dim dic As Object
    Dim rng As Range, cel As Range
    Dim Ws As Worksheet
    
Set dic = CreateObject("Scripting.Dictionary")
Set Ws = Sheets("form")
lr = Ws.Range("c" & Rows.Count).End(xlUp).Row
Set rng = Ws.Range("c1:n" & lr)
Ws.AutoFilterMode = False
For Each cel In Ws.Range("C2:C" & lr)
    
    If Not dic.exists(cel.Value) Then
        rng.AutoFilter field:=1, Criteria1:=cel.Value
        If Not WsExit(cel.Value) Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = cel.Value
        Else
            Sheets(cel.Value).Move after:=Worksheets(Worksheets.Count)
            Sheets(cel.Value).Cells.ClearContents
        End If
        rng.SpecialCells(xlCellTypeVisible).Copy Sheets(cel.Value).Cells(1, 1)
        Sheets(cel.Value).UsedRange.EntireColumn.AutoFit
        dic.Add (cel.Value), ""
        rng.AutoFilter
    End If
Next cel

End Sub