Loop Through Specific Sheets In Workbook And Copy/Paste To 1 overall Sheet

Question

I have multiple sheets starting with BT, on those sheet there are three table ranges I want to copy and paste to one sheet. There is no exact amount of "BT" sheets.

There are some word in Dutch. Example codename Blad3 is the same as Sheet3. I use this because I want to avoid if someone changes a sheetname that the code no longer works.

I know that I have to delete the select functions, but don't know how to get it working then.

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

A few pointers:

• You're using 3 different last row variables for the same sheet? You can overwrite a variable just fine, no need for a 2nd/3rd unless you need to keep them all available for something else.
• You loop with i but then have Next d?
• Unused variable dlRow
• Instead of defining a one-value Array (?), loop through the sheets in wb.Worksheets and check if the name is like "BT*"

So it could look like this:

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

If need be, you can check the sheet isn't Blad3 in case they change its name to "BT"-something.