将多个工作表但不是所有工作表的值复制/粘贴到一个工作表中

Question

我需要从多个工作表复制单元格B3：W400（每次运行时都会有不同的名称）并将值粘贴到“CombinedPlans”中，在最后添加每个新选择。我需要从代码中排除3张：IBExport，MonthlyIBs和组合计划。

大量的反复试验给了我下面的代码，我在我的“练习”工作簿中工作。现在，我已将它放入我的制作工作簿中，不再复制任何工作表。它只是直接跳到消息框。我究竟做错了什么？

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

这应该工作。如果仍有问题，请确保表格CombinedPlans确实如此命名。

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