Chào mọi người. Mình có 1 file có lấy code nguồn từ GPE. tách mỗi dòng ra 1 file. Nhưng vấn đề mình muốn file lưu với dạng text *txt. Nhưng sau khi lưu thì file bị lỗi. Mọi người hỗ trợ giúp.
Mã:
Private Function Unique(Range As Range)
Dim Clls As Range
On Error Resume Next
With CreateObject("Scripting.Dictionary")
For Each Clls In Range
If Not IsEmpty(Clls) Then .Add Clls.Value, ""
Next Clls
Unique = .Keys
End With
End Function
Sub ChiaFile()
Dim MainWs As Worksheet, SubWs As Worksheet, Rng As Range, Item
On Error GoTo Thoat
Application.ScreenUpdating = False
Set MainWs = ThisWorkbook.Sheets("Tonghop")
Set Rng = MainWs.Range(MainWs.[A1], MainWs.[A65536].End(xlUp)).Resize(, 6)
For Each Item In Unique(Intersect(Rng, Rng.Offset(1, 2)).Resize(, 1))
With Workbooks.Add
Set SubWs = .Sheets(1)
SubWs.Name = Item
Rng.AutoFilter 3, Item
MainWs.Range(MainWs.Range("A1"), Rng).SpecialCells(12).Copy
SubWs.Range("A1").PasteSpecial 8
SubWs.Range("A1").PasteSpecial
Rng.AutoFilter
.Close True, ThisWorkbook.Path & "\" & Item & ".txt"
End With
Next
Thoat:
Application.ScreenUpdating = True
End Sub
