Sửa lỗi sai ở VBA gộp nhiều file, nhiều sheet thành 1 sheet

[thanhhong.hr]

Em có rất nhiều file cùng định dạng .xls muốn gộp thành 1 sheet. Em có sử dụng 2 code để gộp nhưng không được, mong mọi người giúp đỡ ạ

 

[LamNA]

Em có rất nhiều file cùng định dạng .xls muốn gộp thành 1 sheet. Em có sử dụng 2 code để gộp nhưng không được, mong mọi người giúp đỡ ạ

Thử dùng code của bác #ndu96081631 theo file này
Lưu ý VBA nên chuyển qua chủ đề lập trình lập trình với excel

Option Explicit
Sub Main()
  Dim vFile, FileItem, aRes, Target As Range
  Dim FileName As String, SheetName As String, RangeAddress As String
  On Error Resume Next
  Application.ScreenUpdating = False
  Sheets("Tong_Hop").Range("A2:F10000").ClearContents
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsx; *.xlsm", , , , True)
  If TypeName(vFile) = "Variant()" Then
    SheetName = "Sheet1": RangeAddress = "A2:F10000"
    For Each FileItem In vFile
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = Sheet1.Range("A60000").End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Done!"
  End If
End Sub

 

[thanhhong.hr]

Thử dùng code của bác #ndu96081631 theo file này
Lưu ý VBA nên chuyển qua chủ đề lập trình lập trình với excel

Option Explicit
Sub Main()
  Dim vFile, FileItem, aRes, Target As Range
  Dim FileName As String, SheetName As String, RangeAddress As String
  On Error Resume Next
  Application.ScreenUpdating = False
  Sheets("Tong_Hop").Range("A2:F10000").ClearContents
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsx; *.xlsm", , , , True)
  If TypeName(vFile) = "Variant()" Then
    SheetName = "Sheet1": RangeAddress = "A2:F10000"
    For Each FileItem In vFile
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = Sheet1.Range("A60000").End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Done!"
  End If
End Sub

Em có dữ liệu gồm rất nhiều file như thế này, mà em gộp không được, em nghĩ do tên" Sheet 1" em có đổi lại mà cũng không được, anh xem lỗi gì em với ạ. Em cám ơn!!!

 

[LamNA]

Em có dữ liệu gồm rất nhiều file như thế này, mà em gộp không được, em nghĩ do tên" Sheet 1" em có đổi lại mà cũng không được, anh xem lỗi gì em với ạ. Em cám ơn!!!

Sửa lại sub Main như thế này

Sub Main()
  Dim vFile, FileItem, aRes, Target As Range
  Dim FileName As String, SheetName As String, RangeAddress As String
  On Error Resume Next
  Application.ScreenUpdating = False
Sheets("Tong_Hop").Range("A2:F60000").ClearContents
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsx; *.xlsm", , , , True)
  If TypeName(vFile) = "Variant()" Then
    RangeAddress = "A2:F60000"
    For Each FileItem In vFile
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = Sheet1.Range("A60000").End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Done!"
  End If
End Sub

 

[thanhhong.hr]

Sửa lại sub Main như thế này

Sub Main()
  Dim vFile, FileItem, aRes, Target As Range
  Dim FileName As String, SheetName As String, RangeAddress As String
  On Error Resume Next
  Application.ScreenUpdating = False
Sheets("Tong_Hop").Range("A2:F60000").ClearContents
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsx; *.xlsm", , , , True)
  If TypeName(vFile) = "Variant()" Then
    RangeAddress = "A2:F60000"
    For Each FileItem In vFile
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = Sheet1.Range("A60000").End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Done!"
  End If
End Sub

em cám ơn anh nhiều ạ

 

[vanhesing]