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

Question

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

Why not just clear your output sheet at the start of the code? — SJR, Jul 08 '19 at 16:19
Avoid using `Select`. And make the `Worksheet` the `Range`s are on explicit. See [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — BigBen, Jul 08 '19 at 16:22
@SJR Because it should be in a table format... if that makes sense? — LondonLondon, Jul 08 '19 at 16:35

SJR · Answer 1 · 2019-07-08T17:01:51.863

1

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

edited Jul 08 '19 at 17:01

answered Jul 08 '19 at 16:30

SJR

22,986
6
18
26

@sjr I really like this one! Pardon my ignorance but how would I have to edit the above if I wanted to only delete the contents in the range B:5 to H:100000? Thanks again – LondonLondon Jul 08 '19 at 16:46
And have the resulting pasted values formatted as a table for filtering? – LondonLondon Jul 08 '19 at 16:49
Code amended above, to just delete everything in Main from B5 down. – SJR Jul 08 '19 at 16:51
This works really well but also deletes the contents in row 4...? – LondonLondon Jul 08 '19 at 16:56
Have added a check which should rectify that. – SJR Jul 08 '19 at 17:02

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

1 Answers1