Solved: Collates data from many sheets to Master sheet

[halimi1306]

Hi Good Day!

Could someone helps me to collates all the data from many sheets to a single master sheet. In my case, i have 85 sheets of data and need to merge in order base on their sheet no. to master sheet (a.k.a "Model Engine").

To solve:

1. Copy data from sheet: F6 to Model Engine (cell D); F8 to Model Engine (cell E) and F19 to Model Engine (Cell E below data from F8) (pls refer to comment on my sheet)
2. The data from sheets (D25:S) need to be copied to Model Engine (F5:U)

Hope you guys can understand what I mean. Your time and effort are highly appreciated.

Sample.zip

Thank you very much.

Halimi T.

[mancubus]

does this help?

http://www.vbaexpress.com/kb/getarticle.php?kb_id=151

[halimi1306]

this code doesn't fit my requirement because the master sheet named "Model Engine already created. In addition I need to get the data from 3 cells in the first two column in Model Engine. Then the data from source sheets will follow in the next column. U could refer to my attachment for better understanding.

Thanks.

[mancubus]

try this.
test on a backup of your file.


[vba]
Sub cons_ws()

Dim ws As Worksheet, wsMaster As Worksheet
Dim LR As Long, ws_LR As Long, wsM_LR As Long, avgF19 As Double

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set wsMaster = Worksheets("Model Engine")

wsM_LR = 4
For Each ws In Worksheets
If UCase(ws.Name) <> UCase(wsMaster.Name) Then
With ws
avgF19 = .Range("F19")
LR = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
ws_LR = .Range("A1:Q" & LR).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
.Range("F6").Copy Destination:=wsMaster.Cells(wsM_LR + 1, "D")
.Range("F8").Copy Destination:=wsMaster.Cells(wsM_LR + 1, "E")
wsMaster.Cells(wsM_LR + 2, "E") = avgF19
.Range("D25:S" & ws_LR).Copy Destination:=wsMaster.Cells(wsM_LR + 1, "F")
End With
End If
wsM_LR = wsMaster.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Next ws

Set wsMaster = Nothing
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub
[/vba]

[halimi1306]

Hi Mancubus,

I'll try to check this out. Thanks

[halimi1306]

Hi,
I solve my problem. Thanks pals.

[VBA]Sub AllDataToForthSheet()
Application.ScreenUpdating = False
Dim SheetCtr As Double
Dim Last1Row As Double
Dim LastShtRow As Double
With ActiveWorkbook
For SheetCtr = 5 To .Sheets.Count
With .Worksheets(SheetCtr)
LastShtRow = .Cells(Rows.Count, "D").End(xlUp).Row
If .Cells(Rows.Count, "J").End(xlUp).Row > LastShtRow Then
LastShtRow = .Cells(Rows.Count, "G").End(xlUp).Row
End If
End With
With .Worksheets(4)
Last1Row = .Cells(Rows.Count, "F").End(xlUp).Row
If .Cells(Rows.Count, "G").End(xlUp).Row > Last1Row Then
Last1Row = .Cells(Rows.Count, "J").End(xlUp).Row
End If
End With
.Worksheets(SheetCtr).Range("D25:S" & LastShtRow).Copy
.Worksheets(4).Range("F" & Last1Row + 1).PasteSpecial xlPasteValues
Next SheetCtr
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub[/VBA]