VBA Loop Копирование ячеек из рабочих листов в мастер-лист

Question

Я довольно новичок в VBA и поэтому ищу помощи.

У меня есть мастер-лист, который я хочу сопоставить данные, собранные с других листов в той же книге, листы 2-60. Я хотел бы скопировать ячейку A4 первого листа в ячейку B3, а данные из ячеек K7: K42 - в ячейку B4: B41. Затем перейдите на следующий лист и вставьте один и тот же диапазон данных в столбцы D3 и D4: D41 и т. Д., Пока не будут скопированы все листы.

Это то, что у меня есть, но, как вы можете сказать, этоЯ буду очень долго писать те же две строки кода для 60+ листов.

If myWs.Name <> "Master" Then

    If myWs.Name = "Sheet2" Then
    Sheets(myWs.Name).Range("K7:K42").Copy Destination:=Sheets("Master").Range("B4")
    Sheets(myWs.Name).Range("A4").Copy Destination:=Sheets("Master").Range("B3")
    End If

    If myWs.Name = "Sheet3" Then
    Sheets(myWs.Name).Range("K7:K42").Copy Destination:=Sheets("Master").Range("C4")
    Sheets(myWs.Name).Range("A4").Copy Destination:=Sheets("Master").Range("C3")
    End If

End If

Next

Я действительно искал SO последние два дня и перепробовал много вещей / кода, но пока что готовлюськоротко и очень запутанно.

Answer 1

Попробуйте этот код:

Sub smth()

Dim myws As Worksheet, i As Long, ind As Long, col As Long

For Each myws In Worksheets

    If myws.Name <> "Master" Then

        ind = 0
        For i = Len(myws.Name) To 1 Step -1
            If IsNumeric(Mid(myws.Name, i, 1)) Then
                ind = i
            Else
                Exit For
            End If
        Next i
        If ind = 0 Then GoTo nextWS
        col = CLng(Mid(myws.Name, ind, Len(myws.Name) - ind + 1))

        myws.Range("A4").Copy Destination:=Sheets("Master").Cells(3, ind)
        myws.Range("K7:K42").Copy Destination:=Sheets("Master").Cells(4, ind)

    End If
nextWS:
Next

End Sub

Этот код будет проверять, есть ли в конце имени вашего листа номера, и если да, он будет использовать этот номер в качестве столбца для вставки.

Answer 2

Попробуйте это:

Option Explicit

Sub test()

    Dim wsMaster As Worksheet, ws As Worksheet
    Dim counter As Long

    counter = 2

    Set wsMaster = ThisWorkbook.Worksheets("Master")

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "Master" Then

            ws.Range("A4").Copy
            wsMaster.Cells(3, counter).PasteSpecial xlPasteValues

            ws.Range("K7:K42").Copy
            wsMaster.Cells(4, counter).PasteSpecial xlPasteValues

            counter = counter + 1

        End If

    Next ws

End Sub