Cách copy dữ liệu nhiều file exel thành 1 file

– 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:

– Bạn để ý ở hình trên tôi có tạo 1 file excel hoàn toàn mới tên là [Combine_All_Excel], tiếp theo mở file excel lên và chọn trên thanh menu “View → Macro“.

– Trong cửa sổ Macro được hiển thị, bạn điền các thông số 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.

– Trong cửa sổ Module1 điền đoạn mã dưới đây (chúng ta nên sửa lại đường dẫn tới thư mục chứa file Exel ở code dưới sao cho phù hợp, trong ví du này của tôi là  D:\Z-Test\EXCEL ):

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.

– Sau khi chạy xong một bảng thông báo kết thúc sẽ hiện thị, bạn chọn “OK” để kết thúc quá trình gom các tập tin excel.

– Dữ liệu của các tập tin excel sẽ được gom lại trong tập tin [Combine_All_Excel] và dưới đây là kết quả.

– Các bạn lưu ý, với Macro trên thì chúng ta chỉ copy dữ liệu từ ổ A2 trở đi chứ không copy ô đầu tiên của các file Exel.
– 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


Tweet