How to consolidate data from multiple sheets into a master excel

[musketeer1989]

Hi Everyone,

I was hoping if someone could help me with a VBA code. I already have a VBA code which imports data from 'sheet 1' of mulitple workbooks into a Master Workbook (xMaster) file. However, I want to adapt the code so that it can import data from 'sheet 2' of multiple workbooks into sheet 2 of the Master Workbook file. Please note data on Sheet 1 and Sheet 2 are different and need to be consolidated in a seperate sheet on master workbook.

For ease I have tried to explain it below:

Workbook A = Sheet A1 & Sheet A2
Workbook B = Sheet B1 & Sheet B2
Workbook B = Sheet C1 & Sheet C2
Workbook C = Sheet D1 & Sheet D2
Workbook D = Sheet E1 & Sheet E2
xMaster Workbook = Master Sheet 1 + Master sheet 2

Master sheet 1 = Sheet A1 + B1 + C1 + D1 + E1
Master sheet 2 = Sheet A2 + B2 + C2 + D2 + E2

My current code:

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "Filepath on the my computer"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "zMaster.xlsm" Then
Exit Sub
End If


Workbooks.Open (Filepath & MyFile)
Range("A2:G300").Copy
ActiveWorkbook.Close


erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Data").Range(Cells(erow, 1), Cells(erow, 7))

MyFile = Dir


Loop
End Sub

 

[sgeng4]

I think all you'd have to do is change sheet1 to sheet2 to make it work, and run the macro in sheet 2 of the summary workbook.

[COLOR=#333333]Sub LoopThroughDirectory()[/COLOR]
[COLOR=#333333]Dim MyFile As String[/COLOR]
[COLOR=#333333]Dim erow[/COLOR]
[COLOR=#333333]Dim Filepath As String[/COLOR]
[COLOR=#333333]Filepath = "[/COLOR][COLOR=#ff0000]Filepath on the my computer[/COLOR][COLOR=#333333]"[/COLOR]
[COLOR=#333333]MyFile = Dir(Filepath)[/COLOR]
[COLOR=#333333]Do While Len(MyFile) > 0[/COLOR]
[COLOR=#333333]If MyFile = "zMaster.xlsm" Then[/COLOR]
[COLOR=#333333]Exit Sub[/COLOR]
[COLOR=#333333]End If[/COLOR]


[COLOR=#333333]Workbooks.Open (Filepath & MyFile)[/COLOR]
[COLOR=#333333]Range("A2:G300").Copy[/COLOR]
[COLOR=#333333]ActiveWorkbook.Close[/COLOR]


[COLOR=#333333]erow = [B]Sheets2[/B].Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row[/COLOR]
[COLOR=#333333]ActiveSheet.Paste Destination:=[B]Worksheets(2)[/B].Range(Cells(erow, 1), Cells(erow, 7))[/COLOR]

[COLOR=#333333]MyFile = Dir[/COLOR]


[COLOR=#333333]Loop[/COLOR]
[COLOR=#333333]End Sub[/COLOR]

Hope that works...

 

[musketeer1989]

@sgeng4 Thank you for your reply.

Do you mean I will need two codes - one for sheet 1 and another for sheet 2? If yes shall I have the each code on sheets rather than modules?

Thanks

 

[sgeng4]

Yes that is what I mean.

Have you tried it out? Did it work?

You can have the codes in the modules; just run then on the sheet that is active.

 

[Fluff]

Another option (untested) change you code like this

Workbooks.Open (Filepath & myfile)
Sheets("[COLOR=#ff0000]sheet1[/COLOR]").Range("A2:G300").Copy [COLOR=#ff0000]Sheet1[/COLOR].Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("[COLOR=#ff0000]sheet2[/COLOR]").Range("A2:G300").Copy [COLOR=#ff0000]Sheet2[/COLOR].Range("A" & Rows.Count).End(xlUp).Offset(1)

ActiveWorkbook.Close


myfile = Dir

Changing sheet names & sheet codenames to suit