将工作簿 Sheet1 中的数据复制到主工作表

Question

I have macro, which copies data from selected workbooks' Sheet1 to this main workbook's Sheet1 in last row. For small number of files, it is fast, but when I select more files (say 20), it breaks and excel even crashes. How to make this more efficient as I am already using Application.EnableEvents and 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. You set a variable for the source workbook, but do not use it.
2. Use With blocks so you don't call the referencing object over and over and over.

3. Write the values directly as opposed to using the slower copy/paste.

    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