Xin gỡ rối code VBA

[xuandongts2011]

Mình có một file cần tách ra các xóm, mình đã tạo ra một nút và viết code tách xóm cho nút này, nhưng khi chạy thì nó lại lấy cả đối tượng x1 vào các xóm còn lại, cộng với mình muốn lấy cả tiêu đề từ hàng 1 đến hàng 4 mà khi chạy thì nó lại mất hàng 2, anh em có kinh nghiệm khắc phục giúp mình, mình xin cảm ơn.

Bài đã được tự động gộp: 16/10/20

Bài đã được tự động gộp: 16/10/20

Sub Tach_file()
Dim Dic As Object
Dim i As Long, Data(), Sdata As Range, Xom As Variant
Set Dic = CreateObject("scripting.dictionary")
Data = Range([A5], [N55536].End(xlUp)).Value 'Lay toi dong cuoi cung chua xom
Set Sdata = Range("A5:AY" & [N55536].End(xlUp).Row) ' lay toi dong cuoi cung cua xom mo rong ra het du lieu
With Application
.ScreenUpdating = False
.DisplayAlerts = False
For i = 1 To UBound(Data)
If Data(i, 14) <> "" Then
Dic.Item(Data(i, 14)) = ""
End If
Next
For Each Xom In Dic.keys
With Sdata
.AutoFilter 14, Xom
.Offset(-3).Copy
Workbooks.Add
With ActiveWorkbook
With .ActiveSheet
.Name = Xom
.[A1].PasteSpecial 1
.[A:AY].Columns.AutoFit
.Rows("5:5").Delete Shift:=xlUp
End With
.SaveAs ThisWorkbook.Path & "\" & Xom, 18
.Close
End With
.AutoFilter
End With
Next

.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

 

[tigertiger]

Mình có một file cần tách ra các xóm, mình đã tạo ra một nút và viết code tách xóm cho nút này, nhưng khi chạy thì nó lại lấy cả đối tượng x1 vào các xóm còn lại, cộng với mình muốn lấy cả tiêu đề từ hàng 1 đến hàng 4 mà khi chạy thì nó lại mất hàng 2, anh em có kinh nghiệm khắc phục giúp mình, mình xin cảm ơn.

Bài đã được tự động gộp: 16/10/20

Bài đã được tự động gộp: 16/10/20

Sub Tach_file()
Dim Dic As Object
Dim i As Long, Data(), Sdata As Range, Xom As Variant
Set Dic = CreateObject("scripting.dictionary")
Data = Range([A5], [N55536].End(xlUp)).Value 'Lay toi dong cuoi cung chua xom
Set Sdata = Range("A5:AY" & [N55536].End(xlUp).Row) ' lay toi dong cuoi cung cua xom mo rong ra het du lieu
With Application
.ScreenUpdating = False
.DisplayAlerts = False
For i = 1 To UBound(Data)
If Data(i, 14) <> "" Then
Dic.Item(Data(i, 14)) = ""
End If
Next
For Each Xom In Dic.keys
With Sdata
.AutoFilter 14, Xom
.Offset(-3).Copy
Workbooks.Add
With ActiveWorkbook
With .ActiveSheet
.Name = Xom
.[A1].PasteSpecial 1
.[A:AY].Columns.AutoFit
.Rows("5:5").Delete Shift:=xlUp
End With
.SaveAs ThisWorkbook.Path & "\" & Xom, 18
.Close
End With
.AutoFilter
End With
Next

.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Thứ nhất cho các code vào thẻ code
Thứ 2, xem lại With phải có End With liền chút, cứ lồng nhau thế khó biết trong With nào
Thứ 3, đã dùng DIC được sao không dùng Array lọc luôn, thay vì AutoFilter cho nửa lạc nửa mỡ (nửa thuần VBA nửa Excel)