Question

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

许多使用反复试验的谷歌搜索给了我以下代码，我在我的“练习”工作簿中工作。现在我已将它放入我的生产工作簿中，它不再复制任何工作表。它只是直接跳到消息框。我做错了什么？

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

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

1 个答案: