Gộp nhiều file thành một file

Chia sẻ bởi:hands

★★★★★

‹ Copy sheet nhưng không copy code Tạo liên kết dữ liệu giữa các... ›

Quảng cáo

Như tiêu đề trong một thư mục em có nhiều file khác nhau. Bây giờ em muốn gộp tất cả các file này thành một file duy nhất (file tổng hợp là tập toàn bộ các sheet trong các file được gộp file). Tên sheet trong các file như thế nào thì vẫn giữ nguyên như vậy. Em đang dùng office 2016. Đã sử dụng một số file gộp trên diễn đàn mà không được vì phần lựa chọn không có phiên bản 2016. Anh chị nào có code mới thì giúp em nhé. Em cảm ơn!

1. Nói có sách, mách có chứng: cho nên phải kèm ít nhất được vài file lên đây, mỗi file có vài sheet. Dĩ nhiên thì tên sheet tại các file phải hoàn toàn khác nhau, vì giống nhau khi gộp lại sẽ bị lỗi. Và 1 file mẫu tổng muốn gộp

2. Bạn dùng code nào, của ai, ở đâu post lên đây…đê có thể xem xét và sửa cho bạn… đỡ phải mắc công đi code mới (không lý gì 2016 không chạy được) 2016 cũng như 2007,2010, 2013 thôi… Chả khác nhau gì cả.
Cho tất cả các file vào 1 Folder. Cho code sau vào 1 file mà bạn muốn tổng hợp vào, chạy code. Cửa sổ mở ra. Chọn nguyên Folder chưa file cần gộp -> Ok đợi kết quả.
P/s: Lưu ý là chọn cả folder rồi ok chứ không phải kiểu chọn Open folder chứa file nha.

Option Explicit
Public Sub GPE()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ChonO As Object, ChonF As Object, pFile, Path
Dim fil As Object, Wb As Workbook, Sh As Worksheet, WbMain As Workbook
pFile = ActiveWorkbook.Name
Set WbMain = ActiveWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "CHON FOLDER"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Path = .SelectedItems(1) & ""
End With
Set ChonO = CreateObject("Scripting.FilesyStemObject")
Set ChonF = ChonO.GetFolder(Path)
For Each fil In ChonF.Files
    If InStr(1, fil.Name, pFile) <= 0 Then
        Set Wb = Workbooks.Open(fil.Path)
        For Each Sh In Wb.Worksheets
        Sh.Cells.Copy
        WbMain.Sheets.Add After:=WbMain.Sheets(WbMain.Sheets.Count)
        WbMain.Sheets(WbMain.Sheets.Count).Name = Sh.Name
        WbMain.Sheets(WbMain.Sheets.Count).[A1].PasteSpecial Paste:=xlPasteAll
        Next Sh
        Workbooks(fil.Name).Close
    End If
Next fil
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub