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

 

[jrman1]

First, thank you to everyone who has helped with this question so far!! I've almost been able to create a working solution for my similar problem because of all of your advice. Sadly, I am coming across a couple errors.

The Macro that I need (and somewhat created) is meant to consolidate data from several workbooks, each with only one sheet, stacking the information in a new workbook. In my case, though, the information present in the original workbooks is in the form of a table that has been filtered to display certain results. As such, when I run a Macro similar to the one above, it either doesn't grab all of the data or it compiles everything regardless of the filter.

If you would so kind as to help me I would be very grateful.

Here is some information~

1) All of the original workbooks are in the same folder/directory, but they are not necessarily sequentially named. As such, I would need a Macro that simply loops over the entire folder of the active workbook. An example workbook could be: "EXT872_VTDT_20130102 Under $3", and the next one could be "EXT872_VTDT_20130103 Under $3", or '*20130104' or '*20130105', etc...

2) The only sheet in every workbook, "$3 and Under", is a table (in the same format for every workbook) that is filtered by the information in column Q. The Table goes from columns A to BN and the number of rows is always different per workbook.
3) Everyday we receive a compiled data report that is unsorted. We have a macro in place that turns the data into a table going from A1 to BN5000, and then sorts the data by the number value in Q, only displaying results that are < 3 and not blank. The tables never really exceed 1500 rows or so, but by making the table extend to row 5000 we never risk losing any data to cutoff.
***For the compiled workbook, we would only want data that meets the above qualification***

4) The location of the original files is: "F:\Trade Blotters\Finished Files - 2013\Sorted By Month\2013 - 01\Under 3"

5) The headers are on row A1 and the data follows starting from row A2 (or whichever row the first 'less than 3' price appears.) We wouldn't want the headers to carry over from every workbook, only the data. And we would want it to appear directly underneath the data of the previous file.

If there's any other information you need I would be more than happy to send it to you.

Thank you, again, for your help!!!

 

[shawnmm2]

I have a complicated excel problem. I am trying to figure out a formula that would add values from multiple sheets into one sheet. The complicated part is that the values are in different cells on different sheets—these are timesheets that are by-weekly with client numbers, total hours worked, total amount billed. I am wondering if there is a formula that would add all "client numbers" from the month of "April 15" into one cell from multiple sheets?

 

[Nat_Barnes]

Hello,

I'm hoping Rosen is still active and will be able to help me out (or any other kind person of course!)!

The original post on this thread is very similar to what I need, except for a few differences:

1) Each source file has the data I need to copy in columns A:AB.
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 "Leads" tab.
4) The 5 source files are titled "PPP AT.xlsx ", "PPP DW.xlsx ", “PPP DCG.xlsx ", "PPP SD.xlsx " and "PPP VV.xlsx " (basically, all other files in the same folder as the 'Destination' file need to be included– in fact, there may become more files in this folder in the future which I’d want including in the data grab).
5) In the destination file, the data will be copied and pasted into the "Leads" tab. I need any autofilters that may be on in the PPP workbooks to be ignored (i.e. I need all the data copying regardless of whether it is filtered or not).
6) The destination file is titled "Destination.xlsx".

Is anyone able to help?

I’m working in Excel 2007.

Thank you all very much in advance.

Nat

 

[Spartin]

Good Afternoon:

So what would the code be if you needed to find the end of your entries?

Thanks in advance

 

[Rosen]

Hi Nat,

Sorry for taking so long to get back to you, if you still need it, try the following code:

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long


Const MAX_PATH = 260


Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
'
Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime  As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh  As Long
  nFileSizeLow   As Long
  dwReserved0   As Long
  dwReserved1   As Long
  cFileName    As String * MAX_PATH
  cAlternate    As String * 14
End Type


Function CleanTrim(ByVal Text As String) As String
    CleanTrim = WorksheetFunction.Trim(WorksheetFunction.Clean(Text))
End Function


Sub CollectData()
    ' This code assumes it is running in the worksheet code itself (Me should be a reference to
    ' the worksheet which the data is being consolidated into).
    ' ---------------------------------------------------------------------------------------------
    Dim i As Long, lCurrRow As Long, lRow As Long, n As Long
    Dim wb As Workbook, ans As VbMsgBoxResult
    Dim hInstance As Long, wFile As WIN32_FIND_DATA, Filename As String
    
    ' ---------------------------------------------------------------------------------------------
    '
    ' ---------------------------------------------------------------------------------------------
    hInstance = FindFirstFile(ThisWorkbook.Path & "\*.xls*", wFile)
    Do
    
        Filename = CleanTrim(wFile.cFileName)
        
    ' -----------------------------------------------------------------------------------------
    ' Ensure we are only grabing other files (skip this one)
    ' -----------------------------------------------------------------------------------------
        If Filename = ThisWorkbook.Name Then GoTo SkipFile
        
    ' -----------------------------------------------------------------------------------------
    ' Ensure we are skipping any temp files generated due to a file being open
    ' -----------------------------------------------------------------------------------------
        If Strings.Left(Filename, 1) = "~" Then GoTo SkipFile
        
    ' ---------------------------------------------------------------------------------------------
    ' Open up Source Workbook
    ' ---------------------------------------------------------------------------------------------
        On Error Resume Next
        WriteTimeStampedEntry "Starting to open file " & Filename
        Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & Filename)
        If Not Err.Number = 0 Then
            Err.Clear
    
    ' ---------------------------------------------------------------------------------------------
    ' No source workbook found, advise user.
    ' ---------------------------------------------------------------------------------------------
            ans = MsgBox("Could not find Source " & Filename & " Workbook." & _
                  vbNewLine & "Do you wish to continue?", vbInformation + vbYesNo, "Error")
            WriteTimeStampedEntry "Error occured opening " & Filename
            If ans = vbNo Then Exit Sub
            GoTo NextI
        End If
        WriteTimeStampedEntry "Finished opening " & Filename
        ' ---------------------------------------------------------------------------------------------
        ' Source book was found, data to use is on CIVIL.
        ' ---------------------------------------------------------------------------------------------
        With wb.Sheets("Leads")
            If Not Err.Number = 0 Then
                Err.Clear
            
    ' -----------------------------------------------------------------------------------------
    ' No CIVIL tab found, advise user.
    ' -----------------------------------------------------------------------------------------
                ans = MsgBox("Could not find Source " & Filename & " Workbook's 'Leads' " & _
                "tab." & vbNewLine & "Do you wish to continue?", _
                vbInformation + vbYesNo, "Error")
                If ans = vbNo Then
                    wb.Close SaveChanges:=False
                    Exit Sub
                End If
                GoTo NextI
            End If
    ' ---------------------------------------------------------------------------------------
    ' Ensure we skip any headers. (set this value to the first row after the headers)
    ' ---------------------------------------------------------------------------------------
            lRow = 2
    ' ---------------------------------------------------------------------------------------
    ' 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.
    ' ---------------------------------------------------------------------------------------
            WriteTimeStampedEntry "Starting data collection for " & Filename
            Do Until .Range("A" & lRow).Value = vbNullString
                lCurrRow = lCurrRow + 1
                If lCurrRow = 1 Then lCurrRow = 2 ' insure we don't overwrite the Leads headers
                For n = 0 To 27 Step 1
                    Me.Range("A" & lCurrRow).Offset(ColumnOffset:=n).Value = .Range("A" & lRow).Offset(ColumnOffset:=n).Value
                Next n
                lRow = lRow + 1
            Loop
            WriteTimeStampedEntry "Finished data collection for " & GetSourceNameByIndex(i)
        End With
NextI:
        wb.Close SaveChanges:=False
        WriteTimeStampedEntry "Closed out " & GetSourceNameByIndex(i)
SkipFile:
    Loop Until FindNextFile(hInstance, wFile) = 0
    FindClose hInstance
    Set wb = Nothing
End Sub


Sub WriteTimeStampedEntry(ByVal msg As String)
    Dim oFileSystem
    Dim oTextStream
    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    Set oTextStream = oFileSystem.OpenTextFile(ThisWorkbook.Path & "\CollectData.log", 8, True)
    oTextStream.WriteLine Now() & ": " & msg
    oTextStream.Close
    Set oTextStream = Nothing
    Set oFileSystem = Nothing
End Sub

This code has not been tested, ensure you back up any data before running.

Hope this helps!

Edit: Just realized Nat's post was from 2015 not 2016... well maybe someone else will need it...

 

[Rosen]

Good Afternoon:

So what would the code be if you needed to find the end of your entries?

Thanks in advance

FirstEmptyRow = Sheets("WorksheetName").Range("A1").End(xlDown).Row + 1

Change the A to whatever column you have continuous data and the 1 to whichever row your data starts on... If you plan on reusing the worksheet in the above code you could add the line (after the declaration of lCurrRow) to:

lCurrRow = Me.Range("A1").End(xlDown).Row

 

[srinu4239]

Same issue is happening with me as well.

Could you please help on this.

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.

 

[MARK858]

Same question as in the post immediately after the one you quoted. Have you put the code in the sheets code module or a regular module?

 

[Algerfan]

hi Rosen
Thank you for the help that provide for others, i have a similar to JHCALI problem which i cant solve, i am not good at coding and i need your help.
i need a folder with one master excel sheet and many other excel sheets as i will be adding along the way, each sheet has a table that is going to be filled on daily bases
i want to copy the information in all sheets in (all cells of the table other than the headers) and consolidate in the master one consequently one copy past after the other
note these files will contain data that is filled daily so last row is not defined it is always changing
can you help me with the code for this and the setup guidelines
where to put the code file path in the code
where to put the name of the excel file in the code
what to name the excel files xls xlsm ?
tab names ....Etc
your help is a highly appreciated

thanx again

 

[Rosen]

I can sure try and help,

A few questions before I provide any code:

The setup is: One Excel file (Workbook) with multiple tabs (Worksheets) which need to be consolidated into one tab (worksheet)?

Will there be a variable number of columns or fixed? Will the names of the columns and order always be the same? Will all worksheets, other then the master, need to be consolidated or are there "extra" worksheets that don't need to be added to the master sheet?

Let me know!