Объединить файлы

Проблемы с кодом

Вы объявили numberOfFilesChosen как Variant:

Dim numberOfFilesChosen, i As Integer ' Wrong

Dim numberOfFilesChosen as Integer, i As Integer ' OK

Вы объявили mainWorkbook как Variant:

Dim mainWorkbook, sourceWorkbook As Workbook ' Wrong

Dim mainWorkbook as Workbook, sourceWorkbook As Workbook ' OK

Такой код должен быть в рабочей книге (mainWorkbook), куда импортируются рабочие таблицы, поэтому вам не нужна переменная, просто используйте ThisWorkbook. Затем в сочетании с оператором With вы можете использовать, например, .Sheets(.Sheets.Count).

Вы переключаетесь между листами и листами. Когда вы используете mainWorkbook.Worksheets.Count, это не обязательно будет последний лист, поэтому было бы правильнее использовать mainWorkbook.Sheets.Count, особенно для того, чтобы добавленный счетчик листов работал правильно.

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

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

Когда вы используете sourceWorkbook.Close, вас могут попросить сохранить книгу. Использование

sourceWorkbook.Close False ' Preferable

закроет книгу без сохранения изменений.

Код не будет выполнен, если вы запустите его в другой раз, потому что имена листов, которые он попытается создать, совпадают. Поэтому я добавил DeleteWorksheetsExceptOne, который использовал при тестировании кода.

Код

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

Удалить все рабочие таблицы, кроме одной

'*******************************************************************************
' 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
'*******************************************************************************