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

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

1 个答案: