excel VBA导入多个工作表很慢

我使用下面的代码从另一个工作簿中导入多个工作表并进行一些处理。 导入时间太长。 任何人都可以build议一个更有效的方法来导入？ 我应该寻找更多的信息在源文件的副本？

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声明，这是没有必要的，但只是浪费了一些时间。

我似乎没有find其他方法来加速你的代码。