Копирование с различных вкладок и вставка в основной лист (VBA)

Question

Мне нужен код, чтобы скопировать все из различных вкладок в ячейках A:H (начиная с строки 3) и вставить все на главной вкладке, начиная с ячейки B5 и двигаясь вниз?

Мой текущий код:

Sub CopyToMainsheet()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Main" Then
            ws.Activate
            Range("A3:H3").Select
            Range(Selection, Selection.End(xlDown)).Copy
            Sheets("Main").Select
            Range("b" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        End If
    Next
End Sub

Проблема с этим кодом заключается в том, что он не возвращается к B5, если вы делаете это более одного раза, и продолжает вставлять ниже того, что уже было вставлено. Мне нужно, чтобы он вставлялся в B5 каждый раз.

Заранее спасибо

Answer 1

Попробуй это. Если в Main есть что-то, что вы хотите сохранить, этот бит нужно настроить.

Sub CopyToMainsheet()

Dim ws As Worksheet, r As Long, r1 As Long

r = 5
With Worksheets("Main")
    r1 = .Range("B" & Rows.Count).End(xlUp).Row
    If r1 > 4 Then .Range("B5", .Range("B" & Rows.Count).End(xlUp)).Resize(, 8).ClearContents
End With

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Main" Then
        ws.Range("A3", ws.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
        Sheets("Main").Range("B" & r).PasteSpecial Paste:=xlPasteValues, _
                                                   Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        r = Sheets("Main").Range("B" & Rows.Count).End(xlUp).Row + 1
    End If
Next

End Sub