V/v tách dữ liệu

[tuanxitin]

Nhờ Anh/Chị xem lại đoạn code tách dữ liệu giúp em, dữ liệu em 216 đơn vị, nhưng mà tách ra có 206 đơn vị, không biết đoạn mã sai chổ nào
Em cảm ơn Anh/chị
Sub Congvan()

Dim AL As Long
Dim BL As Long

Dim i As Integer
Dim a As Long
Dim y As String
Dim v As String
Dim x As String

Dim lr As Long
Dim lc As Long

Dim lrA As Long
Dim lcA As Long
Set wO = Workbooks("Tachfilesophu09thang2024_Final_gui.xlsm")
Set sBr = Sheets("danhsach")
Set sA = Sheets("data")
Application.ScreenUpdating = False
sBr.Select
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Select
LastRow = Selection.Rows.Count
For i = 1 To LastRow
a = sBr.Cells(i, 3).Value ' ma sol
y = sBr.Cells(i, 2).Value ' ten sol
v = y ' & "_" & sBr.Cells(2, 6).Value

Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\Users\Dell\Desktop\nhap\" & v & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Set wBr = Workbooks(v & ".xlsx")
wO.Activate
sA.Select ' data
On Error Resume Next
ActiveSheet.ShowAllData
lrA = Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Rows.Count
lcA = ActiveSheet.UsedRange.Columns.Count
Range(Cells(1, 1), Cells(lrA, lcA)).AutoFilter Field:=1
If Columns("a:A").Find(a) Is Nothing Then
Else
Range(Cells(1, 1), Cells(lrA, lcA)).AutoFilter Field:=1, Criteria1:=a, _
Operator:=xlOr, Criteria2:=y & " Total"

lr = ActiveSheet.UsedRange.Rows.Count
lc = ActiveSheet.UsedRange.Columns.Count
Range(Cells(1, 1), Cells(lr, lc)).Copy

wBr.Activate
Worksheets.Add
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ActiveSheet.Paste
ActiveSheet.Name = "SOPHU9T"
End If
wBr.Save
wBr.Close
Next i
Application.ScreenUpdating = True

End Sub

 

[BuiQuangThuan]

Nhờ Anh/Chị xem lại đoạn code tách dữ liệu giúp em, dữ liệu em 216 đơn vị, nhưng mà tách ra có 206 đơn vị, không biết đoạn mã sai chổ nào
Em cảm ơn Anh/chị

Bạn đừng viết tắt ắt sẽ có người giúp

 

[tuanxitin]

Bạn đừng viết tắt ắt sẽ có người giúp

Em không hiểu, viết tắt nào vậy Anh

 

[SA_DQ]

(1) Nhìn thấy cái file 7M là hết muốn mở rồi;
(2) Lần sau nên là vầy cho tiện với người có nhã ý giúp bạn:

Sub CongVan()
Dim AL As Long, BL As Long, i As Integer, a As Long, lr As Long, lc As Long
Dim y As String, v As String, x As String
Dim lrA As Long, lcA As Long

Set wO = Workbooks("Tachfilesophu09thang2024_Final_gui.xlsm")
Set sBr = Sheets("danhsach")
Set sA = Sheets("data")
Application.ScreenUpdating = False
sBr.Select
Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Select
LastRow = Selection.Rows.Count
For i = 1 To LastRow
    a = sBr.Cells(i, 3).Value ' ma sol
    y = sBr.Cells(i, 2).Value ' ten sol
    v = y ' & "_" & sBr.Cells(2, 6).Value
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="C:\Users\Dell\Desktop\nhap\" & v & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Set wBr = Workbooks(v & ".xlsx")
    wO.Activate
    sA.Select ' data
    On Error Resume Next
    ActiveSheet.ShowAllData
    lrA = Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Rows.Count
    lcA = ActiveSheet.UsedRange.Columns.Count
    Range(Cells(1, 1), Cells(lrA, lcA)).AutoFilter Field:=1
    If Columns("a:A").Find(a) Is Nothing Then
    Else
        Range(Cells(1, 1), Cells(lrA, lcA)).AutoFilter Field:=1, Criteria1:=a, _
            Operator:=xlOr, Criteria2:=y & " Total"
        lr = ActiveSheet.UsedRange.Rows.Count
        lc = ActiveSheet.UsedRange.Columns.Count
        Range(Cells(1, 1), Cells(lr, lc)).Copy
        wBr.Activate
        Worksheets.Add
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
        ActiveSheet.Name = "SOPHU9T"
    End If
    wBr.Save
    wBr.Close
Next i
Application.ScreenUpdating = True
End Sub

Chào nha & chúc ngày đạt nhiều thành công!

 

[minhhieu1985]

của bạn đây nhé bạn chọn sai đường dẫn lưu file