VBA Combine columns on multiple sheets into one sheet

[Tanianiania]

Hi

I have 4 sheets, lets just call them A, B, C and D.

Each of these have separate sets of data however the fields in the first 4 columns on each sheet contains the same fields/type of information.

I want to combine the data from the first 4 columns in each sheet into the first 4 columns on Summary. This would be taking Sheet A: A2:D(last row with data) and pasting onto Sheet Summary A2, then B2:D(last row with data) and pasting on the summary sheet below that, then repeat for C and D.

Sheets A to D have a data connection and each time they are refreshed the last row will be different. All fields are just values no formulas.

Thanks for any help.

Tania

 

[mumps]

Try:

Sub CopyRange()
    Dim bottomD As Integer
    Dim ws As Worksheet
    For Each ws In Sheets(Array("A", "B", "C", "D"))
        ws.Activate
        bottomD = Range("D" & Rows.Count).End(xlUp).Row
        Range("A2:D" & bottomD).Copy Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next ws
End Sub

 

[hiker95]

Tanianiania,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub CombineSheets()
' hiker95, 08/12/2013
' http://www.mrexcel.com/forum/excel-questions/719652-visual-basic-applications-combine-columns-multiple-sheets-into-one-sheet.html
Dim ws As Worksheet
For Each ws In Sheets(Array("A", "B", "C", "D"))
  With ws
    .Range("A2:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1)
  End With
Next ws
Sheets("Summary").Activate
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CombineSheets macro.

 

[Tanianiania]

Great thankyou.

Try:

Sub CopyRange()
    Dim bottomD As Integer
    Dim ws As Worksheet
    For Each ws In Sheets(Array("A", "B", "C", "D"))
        ws.Activate
        bottomD = Range("D" & Rows.Count).End(xlUp).Row
        Range("A2:D" & bottomD).Copy Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    Next ws
End Sub

 

[mumps]

My pleasure.