combine 60 Excel workbooks

[BittenApple]

Hello team,

I am pulling data from a system and the result is coming in a Excel workbook. There are 70 workbooks.
I am looking for a VBA code that combine data from all these workbooks and worksheets and show all of them in a Master Excel workbook.

Regards,
BittenApple.

[HansV]

1) Do you want to copy ALL worksheets of ALL workbooks into a single workbook?

2a) Are the names of the worksheets all different, or are there duplicate names?
2b) If there are duplicates, do you want the code to rename them or is it OK if Excel does that automatically?

[Jim Cone]

I have to ask...
What if the combined workbook is 50MB?

'---
Jim Cone

[BittenApple]

Hello Jim and Hans,
1) Do you want to copy ALL worksheets of ALL workbooks into a single workbook? yes

2a) Are the names of the worksheets all different, or are there duplicate names? When I pull data the worksheet name is same and even the workbook name is same. however I change the workbook name to be able to save all workbooks in one folder;

2b) If there are duplicates, do you want the code to rename them or is it OK if Excel does that automatically?
There are some actions in the each worksheet and they are some digits for each action and the name of customer on the top; The actions are:
action 1, action 2, action 3
and the name of the customer is on top of the sheet.

I have to ask...
What if the combined workbook is 50MB?

no, it is not, each workbook has only one sheet and each sheet has 12 rows.

This is the design of worksheet:
Customer 1

Result1, Result2, Result3, Result4
Action1 1 4 6 9
Action2 2 3 5 1
Action3 .... ..... ..... ....
Action...
Action12
I know I have to do some clean up first for macros. For example: to repeat the name of same customer for all actions in on worksheet.

I thought it is ok if I copy and pasted all the worksheets to one worksheet manually, because I only have 60 sheets; also I thought having code is also nice.

I know I have to do some clean up with Macros first.

Thanks for the help,
BittenApple

[Rudi]

Here is some code to get started.
If you need more changes, you need to provide more specifics.

You need to place all 60 source files into a single folder on your hard drive.
You can copy the code below into a destination workbook (which can act as a template to store the code and run this macro whenever you need to).
The macro does not clear out any additional sheets in this template workbook. It simply copies the source sheets to the end of the current sheets.
The macro does not rename the sheets itself. It relies on Excel's built in process to append a suffix number to the back of similar named sheets.

Code: Select all

Sub CombineFiles()
Dim dFolder As FileDialog
Dim sPath As String
Dim sFile As String
Dim sExt As String
Dim wb As Workbook
Dim ws As Worksheet

    Set dFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With dFolder
        .Title = "Select Target Folder Containing Files to Process..."
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        sPath = .SelectedItems(1) & "\"
    End With
    sExt = "*.xls*"
    sFile = Dir(sPath & sExt)
    
    Do While sFile <> ""
        If sFile <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(FileName:=sPath & sFile)
            Set ws = wb.Sheets(1)
            ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            wb.Close False
            ActiveSheet.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Columns(1).Value = ActiveSheet.Range("A1").Value
            ActiveSheet.Columns.AutoFit
        End If
        sFile = Dir
    Loop
    Sheets(1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Completed processing each workbook in folder: " & vbNewLine & sPath, vbInformation
End Sub

[Jim Cone]

This code places data from one worksheet, in all of the files opened, onto one master sheet in the workbook containing the code.
You must specify the sheet name or sheet number (position)... "vCopyFrom" and "vCopyTo"
You must specify the complete file path to the specific folder.
It uses Like "*.xls*" to process any .xls or .xlsx or .xlsm files it finds.

Code: Select all

Sub ConsolidateFiles()
'Jim Cone - Portland, Oregon USA - last modified April 2016.
On Error GoTo ThatHurt
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim strName As String
Dim vCopyTo As Variant
Dim vCopyFrom As Variant
Dim blnTask As Boolean
Dim lngRow As Long
Dim rngUsed As Excel.Range
Dim rngCell As Excel.Range
Dim WB As Excel.Workbook

    If Val(Application.Version) >= 10 And Val(Application.Version) < 15 Then
        blnTask = Application.ShowWindowsInTaskbar
        Application.ShowWindowsInTaskbar = False
    End If
    Application.ScreenUpdating = False
    'Specify the folder...
    strPath = "C:\Excel Files\Commercial Projects\Brie Larson"    '<<< CHANGE
    'Can use worksheet position or worksheet name
    vCopyTo = 1
    vCopyFrom = 1
    'Use Microsoft Scripting runtime.
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strPath)

    'Check type of file in the folder and open file.
    For Each objFile In objFolder.Files
        If objFile.Name Like "*.xls*" Then
            strName = objFile.Name
            Application.StatusBar = strName
            With ThisWorkbook.Worksheets(vCopyTo)
                lngRow = .UsedRange.Rows.Count
                lngRow = .UsedRange.Rows(lngRow).Row + 3
                .Cells(lngRow - 1, 1).Resize(1, 2).Interior.Color = vbGreen
                .Cells(lngRow - 1, 1).Value = strName
            End With
            Set WB = Workbooks.Open(objFile)
            Set rngUsed = WB.Worksheets(vCopyFrom).UsedRange
            Set rngCell = rngUsed.Cells(rngUsed.Rows.Count, rngUsed.Columns.Count)
            Set rngUsed = rngUsed.Parent.Range("A1", rngCell)
            rngUsed.Copy Destination:=ThisWorkbook.Worksheets(vCopyTo).Cells(lngRow, 1)
            WB.Close savechanges:=False
        End If
    Next    'objFile

CloseOut:
    On Error Resume Next
    If blnTask Then Application.ShowWindowsInTaskbar = blnTask
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing
    Set rngCell = Nothing
    Set rngUsed = Nothing
    Set WB = Nothing
    Exit Sub

ThatHurt:
    Beep
    MsgBox "Error " & Err.Number & " " & Err.Description, , "Consolidate Files"
    Resume CloseOut
End Sub
'---

Jim Cone
https://goo.gl/IUQUN2" onclick="window.open(this.href);return false; (Dropbox)

[BittenApple]

Hello team,
Thank you so very much for the help and I will get back to you if there is more questions.
Regards,
BittenApple,