Gộp dữ liệu từ nhiều file excel trong cung một folder, Các Anh Chị giúp giùm với ạ (1 người xem)

[minhto]

Mình đang muốn gộp dữ liệu từ nhiều file excel trong cùng một folder, dữ liệu được cập nhật từ các sheet của từng file excel riêng lẻ lên file tổng hợp theo thứ tự hết file 1 đến file 2, từng đơn vị, từng dòng một), đồng thời tên đơn vị hiện lên theo thứ tự ở trong sheet "tên đơn vị" ở file tổng hợp - các Anh Chị xem ví dụ đính kèm. Mình muốn viết lệnh để số liệu tự cập nhật (theo kiểu lặp và nếu như có thêm đơn vị mới thì công thức cũng sẽ cập nhật được luôn). Các Anh Chị chỉ bảo giúp mình với. Xin đa tạ

 

[sealand]

Bạn tham khảo code để áp dụng xem sao

Private Sub CommandButton1_Click()
Sheet1.[A2:C65536].Clear
Sheet2.Columns("B").Resize(, 200).ClearContents
Sheet3.Columns("B").Resize(, 200).ClearContents
End Sub

Private Sub CommandButton2_Click()
'Thong ke cac file Excel co trong thu muc voi file Tong Hop
  Dim DsFile(), i, j
   Dim fs, f, f1, fc, s
    Dim Wb As Workbook, Mg, Cl As Range
      Application.ScreenUpdating = False
       On Error GoTo Thoat
         Set fs = CreateObject("Scripting.FileSystemObject")
           Set f = fs.GetFolder(ThisWorkbook.Path)
            Set fc = f.Files
           For Each f1 In fc
          If f1.Name <> "Tong Hop.xls" Then
        i = i + 1
       ReDim Preserve DsFile(1 To i)
     DsFile(i) = f1.Name
   End If
  Next
'Don dep bao cao
Sheet1.[A2:B1000].Clear
Sheet2.Columns("B").Resize(, 200).Clear
Sheet3.Columns("B").Resize(, 200).Clear
 For i = 1 To UBound(DsFile)
  Set Wb = Application.Workbooks.Open(ThisWorkbook.Path & "\" & DsFile(i))
   'Ke danh sach don vi
     Sheet1.[A1000].End(3).Offset(1) = i
      Sheet1.[A1000].End(3).Offset(, 1) = Ten(DsFile(i))
       Sheet1.[A1000].End(3).Offset(, 2) = ThisWorkbook.Path & "\" & DsFile(i)
        'Chep Xe may
         Sheet2.[a1].Offset(, i * 2 - 1) = Ten(DsFile(i))
        Sheet2.[a1].Offset(, i * 2 - 1).Resize(, 2).Merge
       Mg = Wb.Sheets(1).Range(Wb.Sheets(1).[a1], Wb.Sheets(1).[a1].SpecialCells(xlLastCell))
      For Each Cl In Sheet2.Range(Sheet2.[a2], Sheet2.[a65536].End(3))
     For j = 1 To UBound(Mg, 1)
    If Mg(j, 1) = Cl.Value Then
   Cl.Offset(, i * 2 - 1) = Mg(j, 2)
  Cl.Offset(, i * 2) = Mg(j, 3)
 End If
Next: Next
'Chep Oto
Sheet3.[a1].Offset(, i * 2 - 1) = Ten(DsFile(i))
Sheet3.[a1].Offset(, i * 2 - 1).Resize(, 2).Merge
Mg = Wb.Sheets(2).Range(Wb.Sheets(2).[a1], Wb.Sheets(2).[a1].SpecialCells(xlLastCell))
 For Each Cl In Sheet3.Range(Sheet3.[a2], Sheet3.[a65536].End(3))
  For j = 1 To UBound(Mg, 1)
   If Mg(j, 1) = Cl.Value Then
    Cl.Offset(, i * 2 - 1) = Mg(j, 2)
     Cl.Offset(, i * 2) = Mg(j, 3)
    End If
   Next: Next
  Wb.Close
 Next: Application.ScreenUpdating = True
 Exit Sub
Thoat:
 MsgBox "Kiem tra cau truc file bao cao loi khong thuc hien duoc"
End Sub