Need to have File names as Sheet names in this code|VBA & Macros|Excel Forum|My Online Training Hub

Hi everyone,

I found this code online to combine multiple Excel files (100 files) into one as separate Spreadsheets, and it works just fine. However, in the destination file, the Spreadsheet names are general (Sheet(1), Sheet(2), etc.); I need to have the file names as Spreadsheet names in the combined file to be able to recognize them in the new file. Can someone please help me to update this code to serve that purpose?

Sub CombineMultipleFiles()
On Error GoTo eh
    'declare variables to hold the objects required
Dim wbDestination As Workbook
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wb As Workbook
Dim sh As Worksheet
Dim strSheetName As String
Dim strDestName As String
    'turn off the screen updating to speed things up
Application.ScreenUpdating = False 'first create new destination workbook
Set wbDestination = Workbooks.Add 'get the name of the new workbook so you exclude it from the loop below
strDestName = wbDestination.Name 'now loop through each of the workbooks open to get the data but exclude your new book or the Personal macro workbook
For Each wb In Application.Workbooks
If wb.Name < > strDestName And wb.Name < > "PERSONAL.XLSB" Then
Set wbSource = wb
For Each sh In wbSource.Worksheets
sh.Copy After: = Workbooks(strDestName).Sheets(1)
Next sh
End If
Next wb
    'now close all the open files except the new file and the Personal macro workbook.
For Each wb In Application.Workbooks
If wb.Name < > strDestName And wb.Name < > "PERSONAL.XLSB" Then
wb.Close False
End If
Next wb

    'remove sheet one from the destination workbook
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True 'clean up the objects to release the memory
Set wbDestination = Nothing
Set wbSource = Nothing
Set wsSource = Nothing
Set wb = Nothing 'turn on the screen updating when complete
Application.ScreenUpdating = False
Exit Sub
eh:
    MsgBox Err.Description
End Sub

Thanks,
Isaac