HỌC TIN CÙNG THỦ KHOA

Gộp nhiều file Excel thành một file Excel sử dụng ngôn ngữ lập trình VBA. (Visual Basic for Application)

Xem hướng dẫn tại: https://blog.hocexcel.online/huong-dan-gop-nhieu-file-excel-thanh-1-file.html

Code (đã sửa lại):

Sub MergeExcelFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wb As Workbook
    Dim SoDongTrongODauFileTongHop As Long
    Dim SoDongLoaiBoOTungFile As Long

    SoDongTrongODauFileTongHop = 1	' Số dòng trống ở đầu file tổng hợp'
    SoDongLoaiBoOTungFile = 3	' Số dòng loại bỏ ở từng file'
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
        
        If x = 1 Then
            wb.Sheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Sheets(1).Range("A" & (SoDongTrongODauFileTongHop + 1))
        Else
            lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
            ' lr: last row: Dòng cuối cùng. Tuy nhiên, hàm ThisWorkbook.Sheets(1).UsedRange.Rows.Count không tính dòng trống'
            wb.Sheets(1).UsedRange.Offset(SoDongLoaiBoOTungFile).Copy ThisWorkbook.Sheets(1).Range("A" & (lr + SoDongTrongODauFileTongHop + 1))
        End If
        
        wb.Close False
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub