Tổng hợp dữ liệu từ nhiều file nhiều Sheets

Mình có các file con có nhiều sheet khác nhau, và các sheet này sẽ dc copy tương ứng vào các sheet trong file tổng hợp.Mình đã làm thử nhưng nó bị lỗi sửa mãi ko dc, hix hix. Mình up file lên đây, mong thầy ndu & các bác sửa giúp ah.Cám ơn mọi người!

các file có cấu trúc cột dòng khác nhau, dữ liệu minh họa và giải thích quá sơ sài, nên code khó viết đúng ý

Sub TongHop()
  Dim Wb As Workbook, WbMain As Workbook, Ws As Worksheet, Dic As Object, Fso As Object, ObjFoder As Object, ObjFile As Object
  Dim Darr(), ShArr(), ShName As String, Tem
  Dim i As Integer, j As Integer, k As Integer, FistC As Byte, LastC As Long, FistR As Byte, LastR As Long
  Application.ScreenUpdating = False
  Set WbMain = ThisWorkbook
  Set Dic = CreateObject("scripting.dictionary")
  ReDim ShArr(i To WbMain.Sheets.Count)
  For k = 1 To WbMain.Sheets.Count
    ShArr(k) = 2
    With WbMain.Sheets(k)
      Dic.Add .Name, k
      LastR = .Range("A" & Rows.Count).End(xlUp).Row
      LastC = .Range("A1").End(xlToRight).Column
      If LastR > 1 And LastC < 16000 Then .Range("A2").Resize(LastR - 1, LastC).ClearContents
    End With
  Next k
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set ObjFoder = Fso.GetFolder(ThisWorkbook.Path)
  For Each ObjFile In ObjFoder.Files
    If Right(ObjFile, Len(WbMain.Name)) <> WbMain.Name And Fso.GetExtensionName(ObjFile) Like "xls*" Then
      Set Wb = Workbooks.Open(ObjFile)
      For Each Ws In Wb.Sheets
        ShName = Ws.Name
        If Dic.exists(ShName) Then
          If ShName = "Product_Location_3a" Then
            FistR = 3:  FistC = 2
          ElseIf ShName = "Product_Global" Then
            FistR = 3:  FistC = 1
          Else
            FistR = 2:  FistC = 1
          End If
          LastR = Ws.Range("B" & Rows.Count).End(xlUp).Row
          If LastR >= FistR Then
            LastC = Ws.Range("A1").End(xlToRight).Column
            Darr = Ws.Range(Ws.Cells(FistR, FistC), Ws.Cells(LastR, LastC)).Value
            k = Dic.Item(ShName)
            WbMain.Sheets(k).Range("B" & ShArr(k)).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
            ShArr(k) = ShArr(k) + UBound(Darr)
          End If
        End If
      Next Ws
      Wb.Close False
    End If
  Next
  Application.ScreenUpdating = True
End Sub

Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học