为什么这个工作表数组代码会导致系统崩溃？

Question

此代码是拉出多张工作表并粘贴到另一个工作簿中以保存为历史文件，但它不断导致系统崩溃......有什么想法吗？

    Sub TransAll()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Windows("Inventory.xlsm").Activate
    Sheets(Array("Invoice Log", "Beer Inventory", "Liquor Inventory", "Wine 
    Inventory" _
    , "Food Inventory", "Other Inventory", "Transfer Worksheet")).Select
    Sheets(Array("Invoice Log", "Beer Inventory", "Liquor Inventory", "Wine 
    Inventory" _
    , "Food Inventory", "Other Inventory", "Transfer Worksheet")).Copy 
    Before:= _
    Workbooks("TransManager.xlsm").Sheets(1)

    Windows("PrimeCost.xlsm").Activate
    Sheets(Array("Sales", "Labor", "Cost of Sales", "Prime Cost")).Select
    Sheets(Array("Prime Cost", "Sales", "Labor", "Cost of Sales")).Copy 
    Before:= _
    Workbooks("TransManager.xlsm").Sheets(1)

    Application.DisplayAlerts = True
    End Sub

Answer 1

正如@Bigben 和@horst 所评论的，可能会尝试简单的循环方法

    Sub TransAll()
    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook
    'Dim Ws As Worksheets
    Dim Arr1 As Variant, Arr2 As Variant, i As Integer
    Arr1 = Array("Invoice Log", "Beer Inventory", "Liquor Inventory", "Wine Inventory", "Food Inventory", "Other Inventory", "Transfer Worksheet")
    Arr2 = Array("Sales", "Labor", "Cost of Sales", "Prime Cost")

    Set Wb1 = Workbooks("Inventory.xlsm")
    Set Wb2 = Workbooks("PrimeCost.xlsm")
    Set Wb3 = Workbooks("TransManager.xlsm")

    'suggest not to operating on all three excel file open at a time. 
    'instead of above three lines may try commented out code to optimize use of 
    'system resources. if your requirement permits, try copying one file at a time.

    'Set Wb1 = Workbooks.Open("C:\users\user\Desktop\Inventory.xlsm")
    'Set Wb3 = Workbooks.Open("C:\users\user\Desktop\TransManager.xlsm")

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

        For i = LBound(Arr1) To UBound(Arr1)
        Wb1.Worksheets(Arr1(i)).Copy Before:=Wb3.Sheets(1)
        Next i
        ' also suggest to close wb1 here and open wb2 here
        'Wb1.Close False
        'Set Wb2 = Workbooks.Open("C:\users\user\Desktop\PrimeCost.xlsm")

        For i = LBound(Arr2) To UBound(Arr2)
        Wb2.Worksheets(Arr2(i)).Copy Before:=Wb3.Sheets(1)
        Next i
        'Wb2.Close False

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    End Sub