CODEWITHSUNDEEP
excelvbacopypaste
Peck3277
Peck3277

Reputation: 1423

Copy all worksheets into one sheet

I am trying to write an excel macro that will copy all my worksheets into one single worksheet.

All worksheets are layed out the same, 4 columns with data in every cell of every row. Each sheet has a header. I am trying to copy the prefiltered data from each sheet to a results sheet, the data from each sheet will be stacked on top of each other.

So far this is what I have and it's almost working.

Dim sh As Worksheet
Dim iRows As Long

iRows = 0

For Each sh In ActiveWorkbook.Worksheets

sh.Select
Range("A1").Select
Selection.Offset(1, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Worksheets("Results").Select
Range("A1").Select
Selection.Offset(iRows, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues

iRows = Worksheets("Results").UsedRange.Rows.Count
Next sh

My offset is incorrect, when I copy over the next sheet I copy over the data it copies over the previous row.

If anyone can help out that would be great, if you could also explain what I am doing wrong here as well that would be great as I'm new to excel and VBA. I'm guess that I don't understand how the paste works correctly?

Upvotes: 0

Views: 22517

Answers (2)

Peck3277
Peck3277

Reputation: 1423

I managed to figure it out. I'm not sure if my code is ideal but what I needed now works.

I had two blank worksheets in my work book. One was called template and one results. What I have done is added and if loop to ignore those two pages. It seems that because those two blank sheets existed I was adding in extra spaces.

Upvotes: 0

tigeravatar
tigeravatar

Reputation: 26660

Sub tgr()

    Dim ws As Worksheet
    Dim wsDest As Worksheet

    Set wsDest = Sheets("Results")

    For Each ws In ActiveWorkbook.Sheets
        If ws.Name <> wsDest.Name Then
            ws.Range("A2", ws.Range("A2").End(xlToRight).End(xlDown)).Copy
            wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End If
    Next ws

End Sub

Upvotes: 4

Related Questions