– Exel là phần mềm Office được rất nhiều nhân viên văn phòng sử dụng cho nhiều công việc khác nhau: kế toán, dự toán…Trong quá trình làm việc với Exel chúng ta sẽ gặp phải trường hợp đó là nối dữ liệu nhiều file Exel trong cùng 1 thư mục thành 1 file Exel duy nhất. Việc nối dữ liệu này phải đảm bảo đúng số hàng, số cột của các file Exel.
– Đầu tiên tôi sẽ tạo một ví dụ thực tiễn để mô tả lại bài viết này, tôi có một tài liệu excel với nội dung như sau:

– Và tôi có tất cả 6 file với định dạng, bố cục, vị trí như file excel trên và để trong thư mục [D:\Z-Test\EXCEL] như sau:


Marco Name: MergeFilesExcel
Macros in: This Workbook
– Tiếp theo bấm nút Create chương trình [Microsoft Visual Basic for Applications] sẽ hiển thị như hình bên dưới.

Sub MergeFilesExcel() Dim path As String, ThisWB As String, lngFilecounter As Long Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet Dim Filename As String, Wkb As Workbook Dim CopyRng As Range, Dest As Range Dim RowofCopySheet As Integer RowofCopySheet = 2 ThisWB = ActiveWorkbook.Name 'Dien duong dan folder chua cac tap tin excel can gom lai. 'Nhu ban thay toi tien duong dan thu muc chua cai file excel cua toi. path = "D:\Z-Test\EXCEL" Application.EnableEvents = False Application.ScreenUpdating = False Set shtDest = ActiveWorkbook.Sheets(1) Filename = Dir(path & "\*.xls", vbNormal) If Len(Filename) = 0 Then Exit Sub Do Until Filename = vbNullString If Not Filename = ThisWB Then Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename) Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)) Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1) CopyRng.Copy Dest Wkb.Close False End If Filename = Dir() Loop Range("A1").Select Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "Ket Thuc!" End Sub
– Tiếp nhấn nút Run màu xanh bên trên bảng menu icon, hoặc trên thanh menu chọn “Run” → “Run Sub/UserForm F5” để thực thi các lệnh marco vừa tạo.



– Ngoài code trên chúng ta cũng có thể tham khảo code dưới đây :
Sub Gop()
Dim strFileName As Variant, i As Integer
Dim myBook As Workbook, mySheet As Worksheet, myRng As Range
strFileName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", _
Title:="Select files", MultiSelect:=True)
If IsArray(strFileName) Then
Application.ScreenUpdating = False
For i = LBound(strFileName) To UBound(strFileName)
Set myBook = Workbooks.Open(strFileName(i))
For Each mySheet In myBook.Worksheets
Set myRng = mySheet.[A1].CurrentRegion
myRng.Offset(1, 0).Resize(myRng.Rows.Count - 1, myRng.Columns.Count).Copy _
ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
Next mySheet
myBook.Close
Next i
Application.ScreenUpdating = True
End If
End Sub
– Nếu muốn A2 rỗng thì bỏ qua không copy thì chúng ta thêm code dưới :
Sub Gop()
On Error Resume Next
Dim strFileName As Variant, i As Integer
Dim myBook As Workbook, mySheet As Worksheet, myRng As Range
strFileName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", _
Title:="Select files", MultiSelect:=True)
If IsArray(strFileName) Then
Application.ScreenUpdating = False
For i = LBound(strFileName) To UBound(strFileName)
Set myBook = Workbooks.Open(strFileName(i))
For Each mySheet In myBook.Worksheets
Set myRng = mySheet.[A1].CurrentRegion
myRng.Offset(1, 0).Resize(myRng.Rows.Count - 1, myRng.Columns.Count).Copy _
ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
Next mySheet
myBook.Close
Next i
Application.ScreenUpdating = True
End If
End Sub