Naming sheets with workbook name after merging?

Question

I've got over 200 workbooks that I need to merge, the code below will merge the workbooks and add all the sheets into one workbook.

In that workbook the sheets are being named Sheet 1 (1), Sheet 1 (2) and so on.

If the sheet was copied from Workbook1 the sheet name would be workbook 1

Sub mergeFiles()
    'Merges all files in a folder to a main file.
    'Define variables:

    Dim numberOfFilesChosen, i As Integer
    Dim tempFileDialog As FileDialog
    Dim mainWorkbook, sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet

    Set mainWorkbook = Application.ActiveWorkbook
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    'Allow the user to select multiple workbooks
    tempFileDialog.AllowMultiSelect = True
    numberOfFilesChosen = tempFileDialog.Show

    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.Count
        'Open each workbook
        Workbooks.Open tempFileDialog.SelectedItems(i)
        Set sourceWorkbook = ActiveWorkbook

        'Copy each worksheet to the end of the main workbook
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
        Next tempWorkSheet

        'Close the source workbook
        sourceWorkbook.Close

    Next i

End Sub

Answer 1

Add this in you For Each loop

Dim j as integer ‘Add to top of your sub
j = 0 ‘Add inside for loop 

For Each tempWorkSheet In sourceWorkbook.Worksheets
    j= j+1
    tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
    ActiveSheet.Name = sourceWorkBook.Name & “ - “ & j ‘Added Line of code to rename copied tab
Next tempWorkSheet

As long as your workbook names aren’t too long or duplicate, it should be good

Answer 2

Merge Files

Code Issues

You have declared numberOfFilesChosen as Variant:

Dim numberOfFilesChosen, i As Integer ' Wrong

Dim numberOfFilesChosen as Integer, i As Integer ' OK

You have declared mainWorkbook as Variant:

Dim mainWorkbook, sourceWorkbook As Workbook ' Wrong

Dim mainWorkbook as Workbook, sourceWorkbook As Workbook ' OK

Such a code should be in the Workbook (mainWorkbook) where the Worksheets are being imported, so you don't need a variable, just use ThisWorkbook. Then in combination with the With statement, you can use e.g. .Sheets(.Sheets.Count).

You are changing between sheets and worksheets. When you use mainWorkbook.Worksheets.Count, this might not necessarily be the last sheet, so it would be more correct to use mainWorkbook.Sheets.Count especially for the added sheet counter to function correctly.

tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)

tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Sheets.Count) ' Preferable

When you use sourceWorkbook.Close, you might be asked to save the workbook. Using

sourceWorkbook.Close False ' Preferable

will close the workbook without saving changes.

The code will fail if you run it another time, because the sheet names it will try to create are the same. Therefore I have added DeleteWorksheetsExceptOne which I used while testing the code.

The Code

Sub mergeFiles()
    'Merges all files in a folder to a main file.

    'Define variables:
    Dim tempFileDialog As FileDialog
    Dim sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    Dim numberOfFilesChosen As Long, i As Long, j As Long

    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    'Allow the user to select multiple workbooks
    tempFileDialog.AllowMultiSelect = True
    numberOfFilesChosen = tempFileDialog.Show

    With ThisWorkbook
        'Loop through all selected workbooks
        For i = 1 To tempFileDialog.SelectedItems.Count
            'Open each workbook
            Workbooks.Open tempFileDialog.SelectedItems(i)
            Set sourceWorkbook = ActiveWorkbook
            j = 0

            'Copy each worksheet to the end of the main workbook
            For Each tempWorkSheet In sourceWorkbook.Worksheets
                j = j + 1
                tempWorkSheet.Copy After:=.Sheets(.Sheets.Count)
                ' Rename newly added worksheet to the name of Source Workbook
                ' concatenated with "-" and Counter (j).
                .Sheets(.Sheets.Count).Name = sourceWorkbook.Name & "-" & j
            Next

            'Close the source workbook. False for not saving changes.
            sourceWorkbook.Close False
        Next
    End With

End Sub

Delete All Worksheets But One

'*******************************************************************************
' Purpose:  Deletes all Worksheets in the ActiveWorkbook except one.
' Danger:   This code doesn't ask anything, it just does. In the end you will
'           end up with just one worksheet (cStrWsExcept) in the workbook
'           (cStrWbPath). If you have executed this code and the result is not
'           satisfactory, just close the workbook and try again or don't. There
'           will be no alert like "Do you want to save ..." because of the line:
'           ".Saved = True" i.e. "objWb.Saved = True".
' Arguments (As Constants):
'   cStrWbPath
'     The path of the workbook to be processed. If "", then ActiveWorkbook is
'     used.
'   cStrWsExcept
'     The worksheet not to be deleted. If "", then the Activesheet is used.
'*******************************************************************************
Sub DeleteWorksheetsExceptOne()

  Const cStrWbPath = ""          ' if "" then ActiveWorkbook
  Const cStrWsExcept = "Sheet1"  ' if "" then ActiveSheet

  Dim objWb As Workbook
  Dim objWsExcept As Worksheet
  Dim objWsDelete As Worksheet

  If cStrWbPath = "" Then
    Set objWb = ActiveWorkbook
   Else
    Set objWb = Workbooks(cStrWbPath)
  End If

  With objWb
    If cStrWsExcept = "" Then
      Set objWsExcept = .ActiveSheet
     Else
      Set objWsExcept = .Worksheets(cStrWsExcept)
    End If

    ' To suppress the "Data may exist in the sheet(s) selected for deletion.
    '                  To permanently delete the data, press Delete." - Alert:
    Application.DisplayAlerts = False

      For Each objWsDelete In .Worksheets
        If objWsDelete.Name <> objWsExcept.Name Then
          objWsDelete.Delete
        End If
      Next

      ' To suppress the "Do you want to save changes you made to ... ?" - Alert:
      .Saved = True

    Application.DisplayAlerts = True

  End With

End Sub
'*******************************************************************************