Friday 12 October 2018

Merge different excel workbooks into a single workbook into different sheets

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

No comments:

Post a Comment