excel VBA导入多个工作表很慢

Question

我使用以下代码从另一个工作簿导入多个​​工作表并进行一些处理。导入时间过长。有人可以建议一种更有效的导入方式吗？我应该查看源文件中的更多信息以进行复制吗？

Sub SKR_Import()
    On Error GoTo errorhandler
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim Sht As Worksheet
    Set wb1 = ActiveWorkbook
    Dim fd As FileDialog
    Dim filechosen As Integer
    Dim filename As String
    Dim i As Long
    Set fd = Application.FileDialog(msoFileDialogOpen)
    fd.AllowMultiSelect = True
    fd.Title = "Select Excel workbooks to import all sheets"
    filechosen = fd.Show
    If filechosen = -1 Then
        For i = 1 To fd.SelectedItems.Count
            Set wb2 = Workbooks.Open(fd.SelectedItems(i))
            For Each Sht In wb2.Sheets
                Sht.Activate
                ActiveSheet.Copy after:=wb1.Sheets(wb1.Sheets.Count)
            Next Sht
            wb2.Close SaveChanges:=False
        Next i
    End If
    wb1.Activate
    Application.ScreenUpdating = True
    Exit Sub
errorhandler:
    msgBox Error, vbCritical, "Error"
    wb2.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Answer 1

您可以尝试使用sheets 的复制方法（使用s）一次复制它们，而不是在wb2 的工作表上循环：

        Set wb2 = Workbooks.Open(fd.SelectedItems(i))
        ' For Each Sht In wb2.Sheets
        '     Sht.Activate
        '     ActiveSheet.Copy after:=wb1.Sheets(wb1.Sheets.Count)
        ' Next Sht
        wb2.Sheets.Copy after:=wb1.Sheets(wb1.Sheets.Count)
        wb2.Close SaveChanges:=False

这也将摆脱Activate 语句，这不是必需的，只是浪费了一些时间。

我似乎没有找到其他方法来进一步加速您的代码。