复制所有工作簿中的所有工作表（已打开）

Question

我打开了 4 个工作簿（通常它应该与 10 个打开的工作簿一起使用），宏仅从前两个打开的工作簿复制数据，然后出现错误 1004“方法 'copy' od object_Worksheet' 失败”。我真的不明白这是什么错误。

宏：

Sub AllInOne()
 
    Dim sW As Workbook
    Dim sS As Worksheet
    For Each sW In Workbooks
            For Each sS In sW.Sheets
                sS.Copy Before:=Workbooks("All.xlsm").Sheets(1)
            Next sS
    Next sW
End Sub

找到问题的解决方案，或提示）

Answer 1

导入表格

• 请注意，甚至包括隐藏的工作簿，即如果您使用

  PERSONAL.xlsb

  ，其工作（工作表）也将被导入。
• 请注意，隐藏的工作表将被隐藏导入，而非常隐藏的工作表将引发错误。
• 您可以使用简单的 If 语句解决这两个问题。
• 更加小心地使用 Sheets 和 Worksheets 集合。如果声明变量

  As Worksheet

  ，请使用 Worksheets 集合。同样，如果您想使用 Sheets 集合（包括图表），请声明变量

  As Object

  。

工作表

Sub ImportWorksheets() ' charts are not imported
 
    Dim dwb As Workbook: Set dwb = Workbooks("All.xlsm")
    ' If this code is in 'All.xlsm', you don't need to specify its name.
    ' Instead use 'ThisWorkbook':
    'Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
    
    Dim swb As Workbook, sws As Worksheet
    
    For Each swb In Workbooks
        If Not swb Is dwb Then ' exclude the destination workbook
            For Each sws In swb.Worksheets
                sws.Copy Before:=dws
            Next sws
        End If
    Next swb
    
    MsgBox "Imported all worksheets from all open workbooks.", vbInformation
    
End Sub

床单

Sub ImportSheets() ' charts are also imported
 
    Dim dwb As Workbook: Set dwb = Workbooks("All.xlsm")
    ' If this code is in 'All.xlsm', you don't need to specify its name.
    ' Instead use 'ThisWorkbook':
    'Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dsh As Object: Set dsh = dwb.Sheets(1) ' there is no 'Sheet' object
    
    Dim swb As Workbook, ssh As Object ' there is no 'Sheet' object
    
    For Each swb In Workbooks
        If Not swb Is dwb Then ' exclude the destination workbook
            For Each ssh In swb.Sheets
                ssh.Copy Before:=dsh
            Next ssh
        End If
    Next swb
    
    MsgBox "Imported all sheets from all open workbooks.", vbInformation
    
End Sub