Nối nhiều file excel thành một file excel bằng macro trong Excel 2010 | How to combine multiple excel file by macro in Excel 2010?

Nếu bạn thường xuyên làm việc với Excel thì thế nào cũng sẽ gặp phải một trường hợp là gom nhiều tập tin excel khác nhau thành một tập tin duy nhất. Bài viết này sẽ hướng dẫn cách sử dụng macro trong Excel 2010 để giải quyết vấn đề trên.

Do bài viết trước còn hơi sơ xài, một số bạn có gặp chút khó khăn khi xử lý, nên mình đã viết lại một cách chi tiết hơn hi vọng có thể hỗ trợ gì đó cho các bạn. Đầ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:

• Macro 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.

"Hôm nay ngày 04/10/2015 sau một loạt phản hồi lỗi :)) mình tiên hày update mới lại đoạn marcro này, cũng hem biết con hem nữa nhưng chắc ăn dễ xài hơn và fix các lỗi đã được các bạn thị giả phát hiện, rất mong vẫn được sự ủng hộ của các bạn trong thời gian tới."

Đoạn macro mới dưới đây sẽ copy dữ liệu tại sheet 1 của tất các tập tin excel thành 1 tập tin duy nhất trong Sheet 1 của tập tin này. Trong cửa sổ Module1 điền đoạn mã dưới đây:

Sub MergeFilesExcel()

    Dim ThisWB As String
    Dim path As String
    Dim lngFilecounter As Long
    Dim wbDest As Workbook
    Dim shtDest As Worksheet
    Dim WS As Worksheet
    Dim Filename As String, Wkb, WkbDest As Workbook
    Dim CopyRng As Range
    Dim Dest As Range

    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 & "\*.xlsx", vbNormal)
 
    If Len(Filename) = 0 Then Exit Sub
 
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
    
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)

            Dim n As Long        
            For n = 1 To Wkb.Sheets.Count
                If n = 1 Then
                  'MsgBox Wkb.Sheets(n).Name
                  If Wkb.Sheets(n).Range("A1").Value = 0 Then
                      'MsgBox Wkb.Sheets(n).Name & " is empty"
                  Else
                      'MsgBox Wkb.Sheets(n).Range("A1").CurrentRegion.Rows.Count & " Row"
                      'MsgBox ColumnLetter(Wkb.Sheets(n).Range("A1").CurrentRegion.Columns.Count) & " Cols"
                      Set CopyRng = Wkb.Sheets(n).Range("A2:" & ColumnLetter(Wkb.Sheets(n).Range("A1").CurrentRegion.Columns.Count) & Wkb.Sheets(n).Range("A1").CurrentRegion.Rows.Count)
                      Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
                      CopyRng.Copy Dest
                  End If
                End If    
            Next n
                    
            Wkb.Close False
        End If
  
        Filename = Dir()
    Loop

    Range("A1").Select

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    MsgBox "Ket Thuc!"
 
End Sub

Function ColumnLetter(ColumnNumber As Long) As String
    Dim n As Long
    Dim c As Byte
    Dim s As String

    n = ColumnNumber
    Do
        c = ((n - 1) Mod 26)
        s = Chr(c + 65) & s
        n = (n - c) \ 26
    Loop While n > 0
    ColumnLetter = s
End Function

Tip - Mẹo nhỏ:
Trong trường hợp bạn muốn copy tất Sheet 2 hoặc Sheet 3,4,... gì đó bạn chỉ việc thay đổi con số tương ứng tại dòng lệnh "If n 1 Then" ở dưới vòng for là được, ví dụ như tôi muốn copy Sheet 2 của các tập tin excel thì tôi sẽ sửa lại như sau:

            Dim n As Long
            For n = 1 To Wkb.Sheets.Count
                If n = 2 Then

Tiếp theo bạn 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 macro 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 macro này không copy format(định dạng) nó chỉ copy dữ liệu sang thôi, định dạng hình trên là do tôi chỉnh lại để dễ dàng hình thấy kết quả, 6 dòng màu vàng là dòng dữ liệu bằng đầu của mỗi tập tin.

Thêm một lưu ý nhỏ là nó cũng không copy dòng Header đầu tiên của mỗi tập tin excel nha. Nếu có bất kỳ câu hỏi hay khó khăn gì các bạn có thể phản hồi tại đây, nhớ mô tả chi tiết các vấn đề bạn gặp phải nha, nó sẽ giúp mình hỗ trợ các bạn nhanh hơn.

Nếu đoạn macro này không đáp ứng được nhu cầu, bạn có thể xem thêm các chủ đề khác về việc nối nhiều tập tin excel thành 1 như sau:

• Nối Sheet 1 hoặc Sheet 2,3,4,... của nhiều tập tin excel thành một tập tin duy nhât.
• Nối nhiều tập tin excel có nhiều sheet thành một sheet duy nhất trong 1 tập tin excel duy nhất.
• Nối các Sheet của nhiều tập tin excel thành 1 tập tin excel duy nhất tương ứng với các Sheet của các tập tin excel được gom.

Rất mong được sự theo dõi của các bạn, mình sẽ update liên kết - link bài viết mới tại đây.


Write: +Bui Ngoc Son