将多张纸（但不是全部纸）的值复制/粘贴到一张纸中

Question

I am needing to copy cells B3:W400 from multiple sheets (will have varying names each time it is run) and paste values into "CombinedPlans", appending each new selection under the last. I need 3 sheets excluded from the code: IBExport, MonthlyIBs, and Combined Plans.

A lot of googling with trial and error has given me the following code, which I got to work in my "practice" workbook. Now that I have put it into my production workbook, it is no longer copying any sheets. It just skips straight to the message box. What am I doing wrong?

Sub consolidatetest()

Sheets("CombinedPlans").Select
Range("B3:W1048576").Select
Selection.ClearContents

Dim J As Integer
Dim sh As Worksheet
Const excludeSheets As String = "QBExport,MonthlyIBs,CombinedPlans"

On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(sh.Name, Split(excludeSheets, ","))) Then
        Application.GoTo Sheets(sh.Name).[b3]
        Range("B3:W400").Select
        Selection.Copy
       Worksheets("CombinedPlans").Activate
    Range("B1048576").End(xlUp).Offset(rowOffset:=1, columnOffset:=0).PasteSpecial xlPasteValues
    End If
Next
Application.CutCopyMode = False
MsgBox "Complete!"

End Sub

Answer 1

This should work. If you have still problems, make sure that the Sheet CombinedPlans is indeed so named.

Sub consolidatetest()

Dim wb As Workbook
Dim sh_CombPlans As Worksheet

Set wb = ThisWorkbook
Set sh_CombPlans = wb.Sheets("CombinedPlans")
sh_CombPlans.Range("B3:W1048576").ClearContents

Dim sh As Worksheet

For Each sh In ActiveWorkbook.Worksheets
    Select Case sh.Name
        Case "QBExport", "MonthlyIBs", "CombinedPlans":
            'Do Nothing
        Case Else
            sh.Range("B3:W400").Copy
            sh_CombPlans.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End Select
Next

Application.CutCopyMode = False
MsgBox "Complete!"

End Sub