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:

Nối nhiều file excel thành một file excel bằng macro trong Excel 2010

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:

Nối nhiều file excel thành một file excel bằng macro trong Excel 2010 001

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 "ViewMacro".

Nối nhiều file excel thành một file excel bằng macro trong Excel 2010 002

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.

Nối nhiều file excel thành một file excel bằng macro trong Excel 2010 003

"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.

Nối nhiều file excel thành một file excel bằng macro trong Excel 2010 004

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.

Nối nhiều file excel thành một file excel bằng macro trong Excel 2010 005

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ả.

Nối nhiều file excel thành một file excel bằng macro trong Excel 2010 006

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

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





32 comments:

  1. Ad ơi cho em hỏi tại sao em chỉ merge dữ liệu được của 2 files trong khi em có tất cả 5 files, định dạng và biểu mẫu của các files đều giống nhau.

    Em cảm ơn.

    ReplyDelete
    Replies
    1. Hi, bạn
      Mình đã kiểm tra lại code + test thấy không có vấn đề nên bạn thử xem xét một số trường hợp sau nha.
      - Các tập tin excel phải nằm trên cùng một thư mục.
      - Các tập tin excel phải có đuôi mở rông là "xls" hoặc "xlsx".
      - Trong code phần ["path = "Đường dẫn thư mục chứa các tập tin excel cầm gom lại."] bạn tham khảo theo ví dụ [path = "D:\Test\"] có dấu "\" ở cuối.

      Dưa trên thông tin bạn cung cấp mình không thể đoán được chính xác vấn đề bạn gặp phải, nếu có thể thì bạn cung cấp lại code bạn đã chỉnh sửa lại để sử dụng và chụp cho mình tấm hình thư mục chứa các file excel, để mình có thể nắm bắt rõ hơn vấn đề bạn gặp phải ^^!.


      Delete
  2. add ơi cho em hỏi là em làm như add hướng dẫn nhưng sau khi nhấn run sub thì có báo lỗi là Run time eror. Em phải làm sao để giải quyết được lỗi đó?
    Chân thành cảm ơn add

    ReplyDelete
    Replies
    1. Lỗi này có nhiều nguyên nhân, bạn gửi cho mình cái file để mình kiểm tra xem sao.

      Delete
  3. a ơi.e nhấn phím run mà nó ko có dấu hiệu j hết

    ReplyDelete
    Replies
    1. Mình đã viết lại chi tiết hơn bạn thử lại xem sao nha.

      Delete
  4. Mình cũng đã thử đoạn code mà bạn cung cấp, nhưng chỉ hiện ra cột stt thôi, các cột còn lại ko có. Xem giúp mình gặp vấn đề gì vậy? thanks...!

    ReplyDelete
    Replies
    1. Bạn gửi cho mình 2 file excel của bạn để mình test thử xem sao ^^!

      Delete
  5. Cảm ơn bạn rất nhiều !
    MÌnh đã test, rất là ok !

    ReplyDelete
  6. Chào Anh Sơn!
    A cho E hỏi là khi E làm giống như A thì bị báo lỗi: (Như hình)
    http://www.upsieutoc.com/images/2014/09/15/H.019.jpg
    http://www.upsieutoc.com/images/2014/09/15/H.020.jpg
    Vậy lỗi này là lỗi j vậy A, A chỉ E cách khắc phục với.
    Cảm ơn A.

    ReplyDelete
    Replies
    1. Hi, bạn

      Trong Excel hay tất cả các phần mềm offince, microsoft đề không hỗ trợ việc quản lý lỗi và bắt lỗi, nên các lỗi quăng ra thường rất chung chung khó hiểu, nên mình cũng không xác định được lỗi bạn gặp phải.

      Nếu có thể bạn có thể gửi cho tôi các tập tin cần gom lại thành một, còn nếu là tập tin quan trong bạn có thể xóa hoặc thay thế các vùng thông lại, lưu ý là giữ nguyên file và cấu trúc đừng thay đổi, để mình kiểm tra xem sao.

      Còn với thông tin bạn cung cấp thì theo cấu trúc đường dẫn "D:\Users\nmtai.dan\Desktop\New folder" thì mình đoán thì có thể là do phân quyền share thư mục, hay share workbook gì đó gây ra.

      Bạn hãy test thử copy các file đó về ổ "C" hay "D" mà không có phân quyền share thư mục hay workbook và bạn toàn quyền thêm, xóa, xửa các tập tin, rồi chạy lại marco xem sao.


      Delete
  7. mình đã thử thực hiện theo như hướng dẫn, đã hiện box "Kết thúc!", tuy nhiên trong workbook "Combine_all_excel" lại hok hiện dữ liệu gì hết, b giúp m với nhé

    ReplyDelete
    Replies
    1. Bạn gửi cho mình các file excel merger để mình kiểm tra thử xem sao.

      Delete
    2. Bạn có câu trả lời cho problem này chưa? Mình cũng đang gặp vấn đề tương tự.

      Delete
  8. Em da sua cac thong tin va Run nhung khong thay hien box "Ket thuc". Anh giup em voi nha. Many thanks anh


    ReplyDelete
    Replies
    1. Ban copy đoạn mã đã chỉnh sửa cho mình kiểm tra xem sao. ^^!

      Delete
  9. File của e bị hiện "Run-time error '52': bad file or bad number", e click vào Debug thì có mũi tên màu vàng chỉ vào dòng này trong cửa sổ Module1: Filename = Dir(path & "\*.xls", vbNormal)
    ad xem giúp e lỗi j với

    ReplyDelete
    Replies
    1. Theo trang msd lỗi này xảy ra khi tên của một tâp tin hay đường dẫn không hợp lệ theo chuẩn của msd(microsoft), bạn xem lại tên cái tập tin excel rồi nào lạ hay dài quá rồi chỉnh lại xem sao.

      Nếu được bạn chụp tập hình thư mục(chụp luôn cái đường dẫn path) gửi cho mình xem sao.

      Delete
  10. Ad cho tôi hỏi nếu tôi muốn copy giá trị của 6 file đó vào các sheet1 đến sheet6 thì trong file tổng hợp thì sao? như ví dụ của AD đó

    ReplyDelete
  11. Ad giúp tôi với! nếu tôi muốn copy giá trị của 6 file đó vào các sheet1 đến sheet6 thì trong file tổng hợp thì sao? như ví dụ của AD đó

    ReplyDelete
    Replies
    1. Sorry bạn, mình cũng chưa làm trường hợp này bao giờ, để ngâm cứu rồi sẽ viết một bài hướng dẫn sau nha.

      Delete
  12. nếu lấy trên sheet2 thì làm sao ?

    ReplyDelete
    Replies
    1. Thanks bạn, nhờ bạn phát hiện ra một bug. Về vấn để này khi có thời mình sẽ tìm hiểu rồi trả lời bạn sau nha.

      Delete
  13. Nếu các file có tên sheet là "AAAA" không phải Sheet1 thì có lỗi không ? Khi chạy thấy có báo lỗi, debug :

    tại dòng lệnh sau
    Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))

    Thanks Ad

    ReplyDelete
    Replies
    1. Mình đã test với trường hợp bạn nói không có lỗi, cũng test thử các tập tin với Sheet 1 với các tên khác nhau nó đều hiểu vì câu lệnh [Wkb.Sheets(1)] nó hiểu là số thứ tự hay còn còn là Index của sheet chứ không dựa vào tên sheet.

      Bạn cung cấp cho mình câu thông báo lỗi, nếu được thì chup cho mình tấm hình báo lỗi, thư mục, và code, để mình xem có phát hiện manh mối gì hem :))

      Delete
    2. à sau khi kiểm tra vấn đề của bạn npvi1963 thì phát hiện nếu có trên 2 script thì đoạn script này sẽ bị lỗi ngay tại dòng bạn vừa nêu, bạn kiểm tra lại xem có các file excel có 2 sheet trở lên không?

      Delete
  14. Ad cho hỏi muốn kết nối các file excel nhưng bắt đầu từ row thứ 6 thì thế nào ah?

    ReplyDelete
    Replies
    1. "RowofCopySheet = 1" bạn đổi giá trị của biến này 6 là được.

      Delete
    2. Chào Anh!
      em làm như code của anh. Nhưng có một lỗi mà em không sửa được là dữ liệu dán không phải là value. Nó copy luôn định dạng ngày/tháng/năm.
      anh có thể giúp em để nó copy giá trị thôi.
      Thanks anh!
      code em sửa:
      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
      Dim RowofCopySheet As Integer
      RowofCopySheet = 1
      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 = "C:\Documents and Settings\Administrator\Desktop\New Folder (2)\Tap CSV hang ngay"
      Application.EnableEvents = False
      Application.ScreenUpdating = False

      Set shtDest = ActiveWorkbook.Sheets(1)
      Filename = Dir(path & "\*.csv", 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("A1:" & ColumnLetter(Wkb.Sheets(n).Range("A1").CurrentRegion.Columns.Count) & Wkb.Sheets(n).Range("A1").CurrentRegion.Rows.Count - 11)
      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

      Delete
    3. Cái này anh cũng ko rõ, chưa làm ^^! để có time anh ngâm cứu xem sao. Tuy nhiên nó copy luôn định dạng em có thể xử lý nhanh là tìm cách chuyển đổi nó về đúng định dạng mong muốn ở file merge là được (làm tay ^^!).

      Delete
  15. Nguyen Manh Linh26 July 2016 at 04:24

    Ad ơi! Pls giúp mình với !
    Mình có 228 file ecxel cần merger và mỗi file có 120 dòng!
    Khi mình run thì chỉ merger được 13 dòng đầu tiên thôi à!
    Trân trọng!

    ReplyDelete
  16. Nguyen Manh Linh26 July 2016 at 04:48

    À mình phát hiện ra rồi, nếu file có khoảng cách thì dừng ngay tại điểm đó!!!

    ReplyDelete