Копирование данных из рабочих тетрадей Sheet1 в Master Sheet

Question

У меня есть макрос, который копирует данные из листа 1 выбранных книг в лист 1 этой основной книги в последней строке. Для небольшого количества файлов это быстро, но когда я выбираю больше файлов (скажем, 20), он ломается и превосходит даже сбои. Как сделать это более эффективным, так как я уже использую Application.EnableEvents и ScreenUpdating?

Sub Copy_From_Workbooks()

    Dim numberOfFilesChosen, i As Integer
    Dim tempFileDialog As FileDialog
    Dim sourceWorkbook As Workbook
    Dim loLastRow As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    tempFileDialog.Filters.Add "Excel Files", "*.xlsx?", 1
    tempFileDialog.AllowMultiSelect = True
    numberOfFilesChosen = tempFileDialog.Show

    For i = 1 To tempFileDialog.SelectedItems.Count
        Workbooks.Open tempFileDialog.SelectedItems(i)
        Set sourceWorkbook = ActiveWorkbook
        If ActiveWorkbook.Worksheets(1).Range("A1") <> "" Then
            With ActiveWorkbook.Worksheets(1)
                With .Cells(1).CurrentRegion
                    .Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy
                End With
            End With
        End If
        With ThisWorkbook.Worksheets("Sheet1")
            loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Range("A" & loLastRow).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            'ThisWorkbook.Save
        End With
        sourceWorkbook.Close
    Next i
    Application.EnableEvents = False
    Application.ScreenUpdating = True
End Sub

Answer 1

1. Вы устанавливаете переменную для исходной рабочей книги, но не используете ее.
2. Используйте With blocks, чтобы не вызывать объект ссылки снова и снова и снова.

3. Напишите значения напрямую, в отличие от более медленного копирования / вставки.

   For i = 1 To tempFileDialog.SelectedItems.Count
       Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))
       With sourceWorkbook.Worksheets(1)
           If .Range("A1") <> "" Then
               Dim valRange as Range
               With .Cells(1).CurrentRegion
                   Set valRange = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 1)
               End With
           End With
       End If
   
       With ThisWorkbook.Worksheets("Sheet1")
           loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
           .Range("A" & loLastRow).Resize(valRange.Rows.Count,valRange.Columns.Count).Value = valRange.Value
           'ThisWorkbook.Save
       End With
       sourceWorkbook.Close
   Next i