Почему этот код массива листов вызывает сбой системы?

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