CODEWITHSUNDEEP
excelvba
LondonLondon
LondonLondon

Reputation: 1

Copying from Various Tabs and Pasting into Main Sheet (VBA)

I need a code to copy everything from various tabs in cells A:H (starting in row 3) and paste everything on the main tab starting in cell B5 and moving down?

My current code is:

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

The issue with this code is that it doesn't go back to B5 if you do it more than once and keeps pasting below what has already been pasted. I need it to start pasting in B5 every time.

Thanks in advance

Upvotes: 0

Views: 44

Answers (1)

SJR
SJR

Reputation: 23081

Try this. If there's stuff in Main you want to preserve, that bit will need tweaking.

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

Upvotes: 1

Related Questions