Macro to Consolidate Data from Different Workbooks into One Workbook

[JHCali]

Greetings,

I need a macro that gathers information from 5 different workbooks and consolidates it on one tab in a 6th workbook.

For each file, the number of columns is the same, but the number of rows differs. What I need to macro to do is to take the data + column headings from the first of the 5 source files and paste them into the destination file. Then, for each subsequent source file, I need the macro to paste just the data (no column headings) starting in the row immediately below.

Also, this group of 6 files (5 source, 1 destination) will all be in one folder. However, I will be creating new folders on a weekly basis, so I would preferably need the macro to work without me having to go in every week and changing the file path. So below are just examples of names for people to help me with the code, and I can go in and change the details afterward.

Here are the details:

1) Each source file has the data I need to copy in columns A:G.
2) In each source file, the column headings are in row 1, with the data beginning in row 2.
3) In each source file, the data that I need to copy is in the "Data Output" tab.
4) The 5 source files are titled "Source1.xls" to "Source 5.xls"
5) In the destination file, the data will be copied and pasted into the "Data Consolidation" tab.
6) The destination file is titled "Destination.xls"
7) The file path where all the files are located is: "C:\Desktop\Week 1". Each wee I will create a new folder and update the number after the "Week".

I hope this is enough hypothetical information to enable you all to help me with the code.

Thank you all very much in advance.

Regards,

JHCali

 

[NumberCruncher311]

Hi Rosen - below is a copy of the log. One thing I didn't mention before: I'm asked if I want to save changes to each of the source workbooks, and have to click "no" before each one will close.


2/19/2013 10:43:51 AM: Starting to open file CDN Pipeline
2/19/2013 10:43:53 AM: Finished opening CDN Pipeline
2/19/2013 10:43:53 AM: Starting data collection for CDN Pipeline
2/19/2013 10:49:15 AM: Finished data collection for CDN Pipeline
2/19/2013 10:49:19 AM: Closed out CDN Pipeline
2/19/2013 10:49:19 AM: Starting to open file GMJ Pipeline
2/19/2013 10:49:21 AM: Finished opening GMJ Pipeline
2/19/2013 10:49:21 AM: Starting data collection for GMJ Pipeline
2/19/2013 10:52:06 AM: Finished data collection for GMJ Pipeline
2/19/2013 10:52:22 AM: Closed out GMJ Pipeline
2/19/2013 10:52:22 AM: Starting to open file PSF Pipeline
2/19/2013 10:52:23 AM: Finished opening PSF Pipeline
2/19/2013 10:52:23 AM: Starting data collection for PSF Pipeline
2/19/2013 11:00:10 AM: Finished data collection for PSF Pipeline
2/19/2013 11:00:14 AM: Closed out PSF Pipeline

 

[Rosen]

Unfortunately the slow down is in the data transfer and I am not sure how to speed that up. As for the being promted to close the workbook, that was supposed to be handled by the "wb.Close False" line. Try changing it to "wb.Close SaveChanges:=False" and see if that fixes the problem.

 

[NumberCruncher311]

Thanks for your help Rosen! Changing that line worked, each workbook closed on its own so at least now I can run the macro and walk away.

 

[itisalikhan]

Hi there!
I am using your code but the debugger is showing the error, i.e invalid use of Me Keyword. The line is highlighted with red. I am using MS excel 2010. Please help me.

Sub CollectData()
' This code assumes it is running in the Destination.xls file's "Data Consolidation" tab.
' ---------------------------------------------------------------------------------------------
Dim i As Long, lCurrRow As Long, lRow As Long, n As Long
Dim wb As Workbook, ans As VbMsgBoxResult

For i = 1 To 5 Step 1

' -----------------------------------------------------------------------------------------
' Open up Source Workbook
' -----------------------------------------------------------------------------------------
On Error Resume Next
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Source" & i & ".xls")
If Not Err.Number = 0 Then
Err.Clear

' ---------------------------------------------------------------------------------------
' Source Workbook was not found using SourceX.xls format, try Source X.xls format
' ---------------------------------------------------------------------------------------
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Source " & i & ".xls")
If Not Err.Number = 0 Then
Err.Clear

' -------------------------------------------------------------------------------------
' No source workbook found, advise user.
' -------------------------------------------------------------------------------------
ans = MsgBox("Could not find Source " & i & " Workbook." & vbNewLine & "Do you wis" & _
"h to continue?", vbInformation + vbYesNo, "Error")
If ans = vbNo Then Exit Sub
GoTo NextI
End If
End If

' -----------------------------------------------------------------------------------------
' Source book was found, data to use is on Data Output.
' -----------------------------------------------------------------------------------------
With wb.Sheets("Data Output")
If Not Err.Number = 0 Then
Err.Clear

' -------------------------------------------------------------------------------------
' No Data Output tab found, advise user.
' -------------------------------------------------------------------------------------
ans = MsgBox("Could not find Source " & i & " Workbook's 'Data Output' tab." & _
vbNewLine & "Do you wish to continue?", vbInformation + vbYesNo, "Error")
If ans = vbNo Then
wb.Close False
Exit Sub
End If
GoTo NextI
End If

' ---------------------------------------------------------------------------------------
' Ensure we add headers.
' ---------------------------------------------------------------------------------------
If i = 1 Then
lRow = 1
Else
lRow = 2
End If

' ---------------------------------------------------------------------------------------
' We are assuming the value in column A will be filled and there is no breaks until the
' end of our entries. If this is not the case additional code will be needed to
' determine the end of our entries.
' ---------------------------------------------------------------------------------------
Do Until .Range("A" & lRow).Value = vbNullString
lCurrRow = lCurrRow + 1
For n = 0 To 6 Step 1
Me.Range("A" & lCurrRow).Offset(ColumnOffset:=n).Value = .Range("A" & lRow).Offset(ColumnOffset:=n).Value
Next n
lRow = lRow + 1
Loop
End With
NextI:
wb.Close False
Next i
Set wb = Nothing
End Sub

 

[Rosen]

Is the code located in the sheet's code or somewhere else?

 

[itisalikhan]

Is the code located in the sheet's code or somewhere else?

Pardon me, i am not able to understand what you exactly want to ask because i am a beginner with excel. Let me explain, how i am using your codes. I copied the codes, hit the Alt+F11, paste the code and run the macro. I past the same code by right click on Data Consolidation tab, view code. But the it is still not working.

 

[itisalikhan]

Hi there!
at last, i solved it. actually the source files was macro enabled workbooks. So, i added an "m" in the following lines. Now the codes are working properly.

On Error Resume Next
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Source" & i & ".xlsm")
If Not Err.Number = 0 Then
Err.Clear

' ---------------------------------------------------------------------------------------
' Source Workbook was not found using SourceX.xls format, try Source X.xls format
' ---------------------------------------------------------------------------------------
Set wb = Workbooks.Open(ThisWorkbook.Path & "\Source " & i & ".xlsm")
If Not Err.Number = 0 Then
Err.Clear

 

[itisalikhan]

Really pretty good stuff in this post. Rosen, you are kind enough. In this single post, you listened the problems of JHCali, Number Cruncher 311 and me as well and solved it. Bunddddddllllllllllllleeeeeeeee of thanksssssssssssssssssssss.
Two thumbs up for you.

 

[DJAnthonyMark]

I am hoping this is still being monitored, because I could use some help. I ran the code with slight variations to the worksheet names and I get an error of "Invalid Use of ME keyword". Any ideas how I could resolve this? I can post the code if necessary.

I realize that I must use this code on the "Data Consolidation Page".

Thanks

Anthony

 

[DJAnthonyMark]

Alright, so I figured out most of my issues, but I am stuck on the last piece of the puzzle. Instead of looping through the data, can the macro just copy an paste A2:Q50? I have blanks in the dataset therefore I'm not getting all the data I need.

Any help is appreciated.