Объедините несколько файлов xlsx и xls в одну книгу

Question

У меня есть много файлов xlsx и xls в папке, содержащей 2-3 листа в каждом файле. Я хочу объединить все эти файлы в одну рабочую книгу. У меня есть пример кода, но он не объединяет файл xlsx, он выбирает только файлы xls из выбранной папки. Пример кода указан ниже. Помоги мне

Sub MergeFiles ()
    Dim numberOfFilesChosen, i As Integer
    Dim tempFD As FileDialog
    Dim mainWb, sourceWb As Workbook
    Dim tempWS As Worksheet
    Set mainWb = Workbooks.Add 'Application.ActiveWorkbook
    Set tempFD = Application.FileDialog(msoFileDialogFilePicker)

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

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

        'Copy each worksheet to the end of the main workbook
        For Each tempWS In sourceWb.Worksheets
            tempWS.Copy after:=mainWb.Sheets(mainWb.Worksheets.Count)
        Next tempWS

        'Close the source workbook
        sourceWb.Close
    Next i
End Sub

Answer 1

Ваш код работает без проблем с небольшим количеством файлов xls, xlsx и xlsb.Я пробовал с 24 различными файлами.

Sub MergeFiles()

    Application.ScreenUpdating = False  ' **** Gain some performance?

    Dim numberOfFilesChosen, i As Integer
    Dim tempFD As FileDialog
    Dim mainWb, sourceWb As Workbook
    Dim tempWS As Worksheet
    Set mainWb = Workbooks.Add 'Application.ActiveWorkbook
    Set tempFD = Application.FileDialog(msoFileDialogFilePicker)

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

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

        ' Application.ScreenUpdating = True       '****** Uncomment to get more feedback
        ' mainWb.Activate
        ' mainWb.Sheets(1).Range("A1").EntireRow.Insert
        ' mainWb.Sheets(1).Range("A1").Value = sourceWb.Name
        ' Debug.Print sourceWb.Name
        ' Application.ScreenUpdating = True

        'Copy each worksheet to the end of the main workbook
        For Each tempWS In sourceWb.Worksheets
            tempWS.Copy after:=mainWb.Sheets(mainWb.Worksheets.Count)
        Next tempWS

        'Close the source workbook
        sourceWb.Close

    Next i

    Application.ScreenUpdating = True  ' **** Gain some performance?

End Sub