Macro Copy and paste 3 sheets with same layout in another sheet stacked

[Jumarie]

Hi,

I need to consolidate 3 sheets in a workbook into one sheet in same workbook. The data from the 3 sheets need to be stacked underneath each other. Extra rows may be added in the future, so the macro need to copy the entire range of data.

The macro should Not loop through the whole workbook as the workbook contain other sheets as well that i don't want to copy data from.

Here is the process i need:

Sub copydataprocess()


Sheets("EWBudget 2013").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Consolidated SF Data").Select
'Paste in next empty row starting in Column "A"
Range("A1").Select
ActiveSheet.Paste

Sheets("RBBudget 2013").Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Consolidated SF Data").Select
'Paste in next empty row starting in Column "A"
ActiveCell.Offset(20, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("MIBudget 2013").Select

ActiveCell.Offset(-44, -87).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Consolidated SF Data").Select
'Paste in next empty row starting in Column "A"
ActiveCell.Offset(102, 0).Range("A1").Select
ActiveSheet.Paste

End Sub

In Summary. I need to copy all data from 3 sheets with same layout (excluding row 1 which are headings) into one Consolidated Data Sheet. The macro need to find the next empty row and paste the data there.

I have worked on the macro so shorten it and this is what i have so far, but its not working.

-------

Public iRow As Long

--------
Function FindBlankRow(ws) As Long
Dim jRow As Long, kRow As Long, iCol As Integer

Sheets(ws).Select
jRow = 0
For iCol = 1 To 256
kRow = Cells(Rows.Count, iCol).End(xlUp).row
If Cells(kRow, iCol).Value = "" Then
kRow = 0
End If
If kRow > jRow Then
jRow = kRow
End If
Next iCol
FindBlankRow = jRow + 1
End Function


---------
Sub ConsolidateSFData()


iRow = FindBlankRow("Consolidated SF Data")
Sheets("EWBudget 2013").Range("A2").End(xlToRight).End(xlDown).Copy
Sheets("Consolidated SF Data").Range("A" & iRow).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
iRow = iRow + 1 'increment iRow to the next blank row

Sheets("RBBudget 2013").Range("A2").End(xlToRight).End(xlDown).Copy
Sheets("Consolidated SF Data").Range("A" & iRow).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
iRow = iRow + 1

Sheets("MIBudget 2013").Range("A2").End(xlToRight).End(xlDown).Copy
Sheets("Consolidated SF Data").Range("A" & iRow).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = False


End Sub

--------

Will you be able to help me please solve this macro problem?

Thank you very much!!

JBester

 

[Jumarie]

Hi,

I have figure out a more simpler way to find the LastRow and Next empty Row

Sub TransferData()




Dim LastRow As Integer




LastRow = Worksheets("Consolidated SF Data").Range("A65536").End(xlUp).row 'Where is the last cell with data?
Sheets("EWBudget 2013").Range("A2:DA18").Copy Worksheets("Consolidated SF Data").Cells(LastRow + 1, "A") 'Transfer data


LastRow = Worksheets("Consolidated SF Data").Range("A65536").End(xlUp).row
Sheets("RBBudget 2013").Range("A2:DA18").Copy Worksheets("Consolidated SF Data").Cells(LastRow + 1, "A")

LastRow = Worksheets("Consolidated SF Data").Range("A65536").End(xlUp).row
Sheets("MIBudget 2013").Range("A2:DA18").Copy Worksheets("Consolidated SF Data").Cells(LastRow + 1, "A")



End Sub

I works but how do I select the entire range of data in each sheet because the following doesn't work:
example.

Sheets("MIBudget 2013").Range("A2").End(xlToRight).End(xlDown).Copy Worksheets("Consolidated SF Data").Cells(LastRow + 1, "A")

 

[sky1in5]

by setting the lastrow 3 time, your lastrow will only be the last one..

LastRow = Worksheets("Consolidated SF Data").Range("A65536").End(xlUp).row
Sheets("MIBudget 2013").Range("A2:DA18").Copy Worksheets("Consolidated SF Data").Cells(LastRow + 1, "A")

 

[Jumarie]

Hi,

Thank you for the speedy reply and advise and it works!

My problem now is the following.
Extra Rows my be added in the future to example Sheets("MIBudget 2013").

How do I select the entire range of data in each sheet I want to copy from because the following doesn't work:

example..

Sheets("MIBudget 2013").Range("A2").End(xlToRight).End(xlDown).Copy Worksheets("Consolidated SF Data").Cells(LastRow + 1, "A")



How do

 

[sky1in5]

LastRowMiBudget = sheets("MIBudget").range("A" & rows.count).end(xlup).row
LastColMiBudget = sheets("MIBudget").cells(1, columns.count).end(xltoleft).column
Sheets("MIBudget 2013").Range(cells(1,2),cells(LastRowMiBudget,LastColMiBudget).copy

 

[SydneyGeek]

It's not easy to add lines in one sheet in response to what happens in another.
Would it be acceptable to clear the consolidated sheet and just re-paste the data from the others, or would that wipe out other work?

Denis

 

[Jumarie]

I can delete the previous data form previous consolidation. as long as its consolidating the most recent data from
Sheets("RBBudget 2013")
Sheets("EWBudget 2013")
Sheets("EWBudget 2013")

Thanks

 

[SydneyGeek]

This will work if there are no blank rows in your sheets.

Sub Consolidation()
    Dim arSheets()
    Dim rwLast As Long
    Dim i As Integer
    
    arSheets = Array("MI Budget 2013", "RB Budget 2013", "EW Budget 2013")
    
    Sheets("Consolidated SF Data").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    For i = LBound(arSheets) To UBound(arSheets)
        Sheets(arSheets(i)).Activate
        Range("A1").CurrentRegion.Offset(1, 0).Copy _
            Destination:=Sheets("Consolidated SF Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Next i
    Application.CutCopyMode = False
End Sub

Denis

 

[Jumarie]

Hi Denis.

Thanks a MIL!!! It works Perfectly!!!!

Your efforts is much appreciated!!