How to consonlidate 100 different spreadsheets into one workbook?

[Howdy1]

Hi,

Can anyone advise how I can pull over 100 different spreadsheet files into one workbook? I have many diffent files saved in one directory and need to consolidate all of them into one file? Any better ideas to do it via VBA instead of opening up so many times to manually copy them?

Thanks a million,

Jin

 

[Mark F]

This option combines all sheets including blanks

Sub CombineFiles()
'========================================================================
' THIS COMBINES ALL SHEETS FROM ALL WORKBOOKS IN A DIRECTORY INTO ONE WORKBOOK
' MUST BE IN THIS WORKBOOK (OR PERSONAL) - NOT MODULE
'========================================================================
    Dim Path As String
    Dim FileName As String
    Dim Wkb As Workbook
    Dim ws As Worksheet
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '###################################
    Path = "C:\Documents and Settings\All Users\Documents\My Documents\Work Stuff\Test Folder"    'Change as needed  #
    '###################################
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each ws In Wkb.Worksheets
            ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next ws
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

This one combines just "Sheet1" or the First sheet depending

Sub CombineFilesOneSHeet()
'========================================================================
' THIS COMBINES "Sheet1" (OR THE FIRST SHEET - see code) FROM ALL WORKBOOKS IN A DIRECTORY
' INTO ONE WORKBOOK 
' MUST BE IN THIS WORKBOOK (OR PERSONAL) - NOT MODULE
'========================================================================
    Dim Path As String
    Dim FileName As String
    Dim Wkb As Workbook
    Dim ws As Worksheet
    Dim wsmf As Worksheet
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '###################################
    Path = "C:\Documents and Settings\All Users\Documents\My Documents\Work Stuff\Test Folder\Fred"    'Change as needed  #
    '###################################
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
 
        Set wsmf = Wkb.Sheets("Sheet1")    'RENAME AS APPLICABLE
    'Set wsmf = Wkb.Sheets(1) ' Use this line if want ONLY THE first sheet 
        wsmf.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Wkb.Close False
        FileName = Dir()
    Loop
 
End Sub

One of these will do what you need I think

Mark

 

[xenou]

Edit: [deleted] very similar (and better) solution already provided by Mark F.

 

[Junior19]

This one combines just "Sheet1" or the First sheet depending

Sub CombineFilesOneSHeet()
'========================================================================
' THIS COMBINES "Sheet1" (OR THE FIRST SHEET - see code) FROM ALL WORKBOOKS IN A DIRECTORY
' INTO ONE WORKBOOK 
' MUST BE IN THIS WORKBOOK (OR PERSONAL) - NOT MODULE
'========================================================================
    Dim Path As String
    Dim FileName As String
    Dim Wkb As Workbook
    Dim ws As Worksheet
    Dim wsmf As Worksheet
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '###################################
    Path = "C:\Documents and Settings\All Users\Documents\My Documents\Work Stuff\Test Folder\Fred"    'Change as needed  #
    '###################################
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
 
        Set wsmf = Wkb.Sheets("Sheet1")    'RENAME AS APPLICABLE
    'Set wsmf = Wkb.Sheets(1) ' Use this line if want ONLY THE first sheet 
        wsmf.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Wkb.Close False
        FileName = Dir()
    Loop
 
End Sub

One of these will do what you need I think

Mark

This is exactly what i was looking for! (thank heavens I did a search before asking a repeating question...)

Would it be possible to adjust this to get files from a sharepoint-catalog?
Or perhaps give a popup prompting for the catalog location instead of having the location coded?

And, as I'll be using this to generate a report based on a number of forms on a quarterly, bi-annually or annually basis, I'll be having the master document in folder a, and the forms in folder b. I'd like the master document to fetch all files in folder b, and then save a copy of itself with a filename + todays date.

As for now I'll do the latter job manually.

 

[kristalyze]

I've been looking for code that will do this as well! Is there a way to adjust the code so that instead of creating new spreadsheets in the target workbook each time it runs, that it adds all the result to one sheet compilied?

So if I was pulling from three separate workbooks, instead of having "Sheet 1" "Sheet 2" & "Sheet3" created, it would just create "Sheet 1" and have all the lines of data there?

That would be perfect for me! Thanks in advance for any help on this....

 

[Mark F]

One option

This does the same as the other one, ie bringing a copy of each sheet into the workbook, THEN merges those sheets into one.

The advantage is that you can see what it has moved across!

You could also just run the code in purple to combine all sheets in existing workbook

Sub CombineFilesextra()
'========================================================================
' THIS COMBINES ALL SHEETS FROM ALL WORKBOOKS IN A DIRECTORY INTO ONE WORKBOOK
' THEN COMBINES ALL ONTO ONE SHEET
' PUT CODE IN THIS WORKBOOK (OR PERSONAL) - ******NOT MODULE*****
'========================================================================
    Dim Path As String
    Dim FileName As String
    Dim Wkb As Workbook
    Dim ws As Worksheet
    On Error Resume Next
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    '###################################
    Path = "C:\Documents and Settings\All Users\Documents\My Documents\Work Stuff\Test Folder"    'Change as needed  #
    '###################################
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each ws In Wkb.Worksheets
            ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next ws
        Wkb.Close False
        FileName = Dir()
    Loop
 
    ' ALL SHEETS COMBINED - CODE BELOW
    Sheets.Add Before:=Sheets(1)
   Sheets(1).Activate
   For Each ws In ActiveWorkbook.Worksheets
       If ws.Name <> ActiveSheet.Name Then
           ws.UsedRange.Offset(0).Copy
           With Range("A65536").End(xlUp).Offset(2, 0)
   ' Change Offset to number of rows blank between 2 = 1 blank row, 3 = 2 Blank rows
               .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                             False, Transpose:=False
               .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                             False, Transpose:=False
           End With
       End If
   Next
   Sheets(1).Select
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

 

[kristalyze]

This is awesome Mark - thanks! The thing is that the macro will be run repeatedly (so that the data is always up to date) and I'm going to run a pivot table off the combined data so that the user will see only the items that pertain to them. It wouldn't be a problem if there were just the three sheets that show the data before its consolidated, but as it is now it adds three additional sheets each time the macro runs. So everytime the user opens their 'Summary' spreadsheet, they would add on another four sheets (the 3 data sheets + 1 consolidated sheet). So I think it may be 'cleaner' for my purposes if the data would just consolidate onto the same sheet each time (named "Summary") and just replace what was there previously? Does that make sense? (sorry if I'm doing a lousy job of explaining this - I probably should have started from the beginning with what i'm trying to accomplish which is three master workbooks with items assigned to 9 different staff members and I need a sheet for each staff member which will display just the items assigned to them from all three workbooks.)

Thanks again for your helpful and prompt responses!

 

[Mark F]

Hi. Have got a solution I was working on but wanted to test properly.

My pc is now playing dead so just wondering if anyone else has a solution in the meantime

Otherwise will post when pc is fixed

Mark

 

[kristalyze]

Hey Mark,

Thanks! I'm still trying to chip away at things but haven't got it working so looking forward to seeing your code when things are up and running again!

K

 

[Mark F]

Hi

This is "cobbled together" from bits I have learned from and copied

Not sure whether it is exactly what you need, but give it a try

Mark

Sub MergeAllDataFromSheetOneInAllFilesInFolder()
'========================================================================
' THIS CONSOLIDATES ALL DATA FROM FIRST SHEET OF EVERY EXCEL FILE IN THE
' SPECIFIED FOLDER, ON TO THE "SUMMARY" SHEET.
' USES COLUMN A TO FIND THE LAST ROW
'========================================================================
    Dim Path As String
    Dim ThisWkb As String
    Dim DestSheet As Worksheet
    Dim Filename As String
    Dim FolderWkb As Workbook
    Dim RangetoCopy As Range
    Dim DestRng As Range
    Dim FirstRowToCopy As Integer
    ThisWkb = ActiveWorkbook.Name
    Path = "C:\Documents and Settings\All Users\Documents\My Documents\Work Stuff\Test Folder\fred"
    FirstRowToCopy = 1    ' 1st row of the data to copy - change as needed
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set DestSheet = ActiveWorkbook.Sheets("Summary")
    Filename = Dir(Path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Filename <> ThisWkb Then
            Set FolderWkb = Workbooks.Open(Filename:=Path & "\" & Filename)
            Set RangetoCopy = FolderWkb.Sheets(1).Range(Cells(FirstRowToCopy, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
            Set DestRng = DestSheet.Range("A" & DestSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1)
            RangetoCopy.Copy
            DestRng.PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
            FolderWkb.Close False
        End If
        Filename = Dir()
    Loop
    Range("A1").Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "All Files in Folders Complete!"
End Sub