Copy all worksheets into one sheet

Question

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?

`1` Avoid using .Select. See this [link](http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select/10718179#10718179) Directly work with the objects. `2` Next see this [link](http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba) on how to find the last row. In the source sheet you can use this to define your range and in the output sheet you can decide the next available row to write. — Siddharth Rout, Sep 17 '13 at 16:14
I see you have already selected the answer. Quick question... You can choose to ignore this as well like you did for the above comment :) Is there a possibility that the top row or the last column might have empty cells? — Siddharth Rout, Sep 17 '13 at 16:23
Hi Siddhart, sorry I accepted the answer just before I got yours! I'm going to have a read over your links. The two extra sheets that I had that I am now ignoring; 1. Had a header and a blank row and 2. was completely blank. — Peck3277, Sep 17 '13 at 16:36
No worries... Just remember if the top row or the right most column has any blank cell then `xlToRight` or `xlDown` won't work... — Siddharth Rout, Sep 17 '13 at 16:40

score 4 · Accepted Answer · answered Sep 17 '13 at 16:15

4

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

answered Sep 17 '13 at 16:15

tigeravatar

26,199
5
30
38

I managed to figure out how to get my code working. Yours is much better and clearer than mine so I'll give the answer to you. – Peck3277 Sep 17 '13 at 16:17

score 0 · Answer 2 · answered Sep 17 '13 at 16:16

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.

Copy all worksheets into one sheet

2 Answers2

Linked