循环工作簿中的特定工作表并复制/粘贴到整个工作表

Question

我在此网站上找到了各种信息来自动化我的 Excel 文档。

只有一个问题是我找不到正确的信息来使 vba 代码正常工作。我知道我做错了什么，但我不知道哪里出了问题。

我想做什么？我有多个以 BT 开头的工作表，在这些工作表上有 3 个表格范围，我想将其复制并粘贴到 1 个工作表中。因为没有确切数量的“BT”表，所以我需要动态获取代码。

我一直在尝试不同的选项，我认为最适合我的文档，我无法开始工作，也不知道我在代码中做错了什么。

有一些荷兰语单词，因为我住在荷兰。

示例代号 Blad3 与 Sheet3 相同。我经常使用这个，因为我想避免如果有人更改工作表名称，代码就不再起作用。

我知道我必须删除选择的功能，但不知道如何让它工作。

Sub Overzicht_2()

Dim ShtNames As Variant: ShtNames = Array("BT")
Dim LR62 As Long
Dim LR63 As Long
Dim LR98 As Long

    Application.ScreenUpdating = False

Dim wb As Workbook: Set wb = ThisWorkbook
Dim wtrws As Worksheet
Dim i As Long
    
    For i = LBound(ShtNames) To UBound(ShtNames)
        On Error Resume Next
        Set wtrws = wb.Worksheets(ShtNames(i))
        On Error GoTo 0
        If Not wtrws Is Nothing Then
            'Code 62
            wtrws.Range("B11:V170").Copy
            LR62 = Blad3.Cells(Rows.Count, "B").End(xlUp).Row
            Range("B" & LR62).Select
                Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=False
            
            'Code 63
            wtrws.Range("B176:V205").Copy
            LR63 = Blad3.Cells(Rows.Count, "B").End(xlUp).Row
            Range("B" & LR63).Select
                Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=False
            Range("A1").Select
            'Code 98
            wtrws.Range("B211:V290").Copy
            LR98 = Blad3.Cells(Rows.Count, "B").End(xlUp).Row
            Range("B" & LR98).Select
                Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=False
            
        End If
    Next d
    
Application.ScreenUpdating = True

Blad1.Select
Range("B3").Select

End Sub

我希望有人能帮助我。

Answer 1

几点提示：

• 您在同一张表中使用了 3 个不同的最后一行变量？您可以很好地覆盖一个变量，不需要第二/第三个变量，除非您需要将它们全部用于其他用途。
• 你用 i 循环，然后有

  Next d

  ？
• 未使用的变量 dlRow
• 不要定义单值数组（？），而是循环遍历

  wb.Worksheets

  中的工作表并检查名称是否类似于“BT*”

所以它可能看起来像这样：

Sub Overzicht_2()
    
    Application.ScreenUpdating = False
    Dim lRow3 As Long, i As Long
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wtrws As Worksheet
    Dim arrRanges
    
    arrRanges = Array("B11:V170", "B176:V205", "B211:V290")
        
    For Each wtrws In wb.Worksheets
        If wtrws.Name Like "BT*" Then
        'you could also use If Left(wtrws.Name,2) = "BT"
            For i = 0 To UBound(arrRanges)
                wtrws.Range(arrRanges(i)).Copy
                lRow3 = Blad3.Cells(Rows.Count, "B").End(xlUp).Row + 1
                '+1 so you don't overwrite the last row with data
                Blad3.Range("B" & lRow3).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=False
            Next i
        End If
    Next wtrws
    
    Application.ScreenUpdating = True
    
    'in case you really need to have this selected, you can leave this part in
    'Blad1.Select
    'Range("B3").Select
End Sub

如果需要，您可以检查该表不是 Blad3，以防他们将其名称更改为“BT”之类的东西。