VBA代码可在新工作簿中使用，但我不希望它在其中工作

我有一个工作簿，宏不起作用，基本上只是从单元格A3复制并向下复制每个工作表中的值，然后依次将每个粘贴到新的摘要工作表中。

当我从字面上创建新工作簿并将所有工作表复制并粘贴到新工作簿中时，一切正常。但是如果我呆在旧的工作簿中，则会出现错误

  

选择工作表类的方法失败

在我创建的其他两本工作簿中，并没有与我复制的完全相同的工作表，这没有失败……为什么这本特定工作簿呢？

我关闭了所有其他工作簿，以避免activeWorkBook出错-也许不是最好的处理方式，但这不应对此产生影响。

Option Explicit
Public Sub SelectItemsEstimate()
Dim ws As Worksheet
Dim LastRow As Long
For Each ws In activeWorkbook.Worksheets
If ws.Name <> "Business Unit Key" _
And ws.Name <> "dv" And ws.Name <> "cc" And ws.Name <> "wer" And ws.Name <> "dafd" _
And ws.Name <> "Master Sheet Summary Data" _
And ws.Name <> "Query for Macro" _
And ws.Name <> "Query for Macro 2 with Format" _
And ws.Name <> "Paste all values" _
And ws.Name <> "Summary" Then
Worksheets(ws.Name).Select
Range("A3",Range("A3").SpecialCells(xlCellTypelastCell)).Select
Selection.Copy
With activeWorkbook.Worksheets("Summary")
LastRow = .Cells(.Rows.Count,"A").End(xlUp).Row ' get last row with data in column "A"
' paste
.Range("A" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
End With
End If
Next
End Sub


  

选择工作表类的方法失败

这可能是由于工作表可见性引起的-excel无法选择隐藏或非常隐藏的工作表。尝试使用此代码来检查某些工作表是否不可见

Sub CheckSheetVisibility()
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
For Each ws In wb.Sheets
If Not ws.Visible = xlSheetVisible Then ws.Visible = xlSheetVisible
Next
End Sub


这里介绍了如何重构代码以避免ActiveWorkbook / ActiveSheet语句出现问题，并且无需使用.Select / .Activate方法。

Sub SelectItemsEstimate()
Dim ws As Worksheet
Dim wb As Workbook
Dim wsToCopyTo As Worksheet
Dim LastRow As Long
Set wb = ThisWorkbook
Set wsToCopyTo = wb.Sheets("Summary")
For Each ws In wb.Sheets
If ws.Name <> "Business Unit Key" _
And ws.Name <> "dv" And ws.Name <> "cc" And ws.Name <> "wer" And ws.Name <> "dafd" _
And ws.Name <> "Master Sheet Summary Data" _
And ws.Name <> "Query for Macro" _
And ws.Name <> "Query for Macro 2 with Format" _
And ws.Name <> "Paste all values" _
And ws.Name <> "Summary" Then
With ws
Range(.Cells(3,1),.Cells(Rows.Count,1).End(xlUp)).Copy
End With
wsToCopyTo.Cells(Rows.Count,1).End(xlUp).Offset(1,0).PasteSpecial Paste:=xlPasteValues
End If
Next
End Sub