Sub MoodyProjectReport() 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 Worksheets("List").Activate Dim r As Integer r = 1 For Each Sheet In Sheets Sheet.Name = Cells(r, 1).Value r = r + 1 Next Worksheets("Summary").Move _ after:=Worksheets("List") Application.DisplayAlerts = False Sheets("List").Delete Application.DisplayAlerts = True End Sub