Gộp nhiều files excel vào thành 1 file nhiều sheets

Liên hệ QC

kelacloi

Thành viên thường trực
Tham gia
6/11/14
Bài viết
331
Được thích
156
Giới tính
Nam
Chào anh, chị,

Em có một số file excel, mỗi file chỉ có duy nhất 1 sheet (tên bất kỳ).
Em muốn gộp các file con vào 1 file tổng hợp, sheet ở file con đó chuyển vào file tổng hợp, tuy nhiên, tên của SHEET đó phải là tên của File con.
Ví dụ: File con có tên 11211.XLSX, trong đó có sheet tên ABC. Khi tổng hợp vào file tổng hợp thì sheet ABC đó em muốn đổi nó thành tên là 11211.

Em có tìm đoạn coede trên internet nhưng chưa biết đổi tên sheet thế nào.
Mong anh, chị giúp đỡ.
Cảm ơn anh, chị.

Mã:
Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
 
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
 
    If (vbBoolean <> VarType(fnameList)) Then
 
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
 
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
 
            Set wbkCurBook = ActiveWorkbook
 
            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
 
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
 
                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
 
                wbkSrcBook.Close SaveChanges:=False
 
            Next
 
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
 
            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
 
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub
 

File đính kèm

  • Demo_files.rar
    39.5 KB · Đọc: 19
Chào anh, chị,

Em có một số file excel, mỗi file chỉ có duy nhất 1 sheet (tên bất kỳ).
Em muốn gộp các file con vào 1 file tổng hợp, sheet ở file con đó chuyển vào file tổng hợp, tuy nhiên, tên của SHEET đó phải là tên của File con.
Ví dụ: File con có tên 11211.XLSX, trong đó có sheet tên ABC. Khi tổng hợp vào file tổng hợp thì sheet ABC đó em muốn đổi nó thành tên là 11211.

Em có tìm đoạn coede trên internet nhưng chưa biết đổi tên sheet thế nào.
Mong anh, chị giúp đỡ.
Cảm ơn anh, chị.

Mã:
Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

    If (vbBoolean <> VarType(fnameList)) Then

        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1

                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)

                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next

                wbkSrcBook.Close SaveChanges:=False

            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If

    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub
Mình cũng chưa chạy thử file nhưng mình nghĩ nó ở chỗ này, bạn thử xem sao:
Rich (BB code):
For Each wksCurSheet In wbkSrcBook.Sheets
    countSheets = countSheets + 1
    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
    activesheet.name=wbkSrcBook.name
Next
 
Upvote 0
Mình cũng chưa chạy thử file nhưng mình nghĩ nó ở chỗ này, bạn thử xem sao:
Rich (BB code):
For Each wksCurSheet In wbkSrcBook.Sheets
    countSheets = countSheets + 1
    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
    activesheet.name=wbkSrcBook.name
Next
Em đã thêm vào và chạy rồi. Nó ổn rồi anh, thừa cái đuôi .xls, .xlsx.
Cảm ơn anh!
 
Upvote 0
Web KT
Back
Top Bottom