Consolidating Workbooks

[rusted314]

Hi,
I have 85 workbooks in the same folder with a sheet in each workbook called "Budgets". Its the same template in each workbook with different data. I need to create a Summary master file of all my budgets so in the end I will have 1 Workbook with the 85 copies of the "Budgets" Worksheets. Does anyone know the VBA for this?
Thanks
John

 

[jbeaucaire]

A gently edited version of a macro I already had for this task. It goes in the Master workbook. It will delete all existing sheets in the workbook and import the BUDGETS sheet from all the files in the noted directory as sheets called Budget-1, Budget-2, etc.

Option Explicit

Sub Consolidate()
'JBeaucaire (7/6/2009)     (2007 compatible)
'Open all Excel files in a specific folder and import data as separate sheets

Dim strFileName As String, strPath As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet
Dim Cnt As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

'Setup
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Cnt = 1

'Remove existing sheets (optional, remove this section if appending is desired)
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    For Each ws In Worksheets
        If ws.Name <> "Temp" Then ws.Delete
    Next ws

'Folder that holds the workbooks to import
    strPath = "C:\My Documents\Budgets\"
    If Left(strPath, 1) <> "\" Then strPath = strPath & "\"

'List of files to import
    strFileName = Dir(strPath & "*.xl*")

'Import Budget sheet with new name from all workbooks
    Do While Len(strFileName) > 0
        Set wbkOld = Workbooks.Open(strPath & strFileName)
        If Evaluate("ISREF(Budgets!A1)") Then
            Sheets("Budgets").Name = "Budgets-" & Cnt
            Sheets("Budgets-" & Cnt).Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
            Cnt = Cnt + 1
        End If
        strFileName = Dir
        wbkOld.Close False
    Loop
    
'Delete the temp sheet leaving only budgets
wbkNew.Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[rusted314]

Thank you for the quick response. I created a blank workbook called Summary.XLS and I updated the path in the macro. The Macro does loop through all of the Excel workbooks in the folder when I run it, however when it finishes running it is simply shutting down my summary.xls document. When I reopen it the files are not copied. Any ideas?
Thanks

 

[jbeaucaire]

Don't let it run solo. Run the macro using the F8 key to step through the code one line at a time. Keep switching back and forth between the sheet and the editor to see what it is doing.

Since I actually use this macro frequently in my own stuff, the technique is sound, so there must be something wrong with:

1) The edits you made to the code
2) The sheets don't have a sheet in them named exactly Budgets, even a hidden space would be a non-match

        If Evaluate("ISREF(Budgets!A1)") Then
            Sheets("Budgets").Name = "Budgets-" & Cnt
            Sheets("Budgets-" & Cnt).Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
            Cnt = Cnt + 1
        End If

This is the part of the code that verifies it can find the Budgets sheet before it tries to copy anything.

=======
Also, there's nothing in my macro that closes the SUMMARY workbook. If it is closing, then you've definitely changed something / added something I can't comment on without seeing it. The macro should not close the SUMMARY workbook.

 

[rusted314]

Yes. I did modify. I realized after I ran the code and reviewed that not all of the tabs were standard and the majortiy were called "budget entry" I updated the few sheets to standardize and adjusted the code. Would the space have made the difference? The other edit I made was taking out the Trim line because I kept getting a error on this. Not sure if that made a difference.

Option Explicit
Sub Consolidate()
'JBeaucaire (7/6/2009) (2007 compatible)
'Open all Excel files in a specific folder and import data as separate sheets
Dim strFileName As String, strPath As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet
Dim Cnt As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'Setup
Set wbkNew = ThisWorkbook
wbkNew.Activate
Cnt = 1
'Remove existing sheets (optional, remove this section if appending is desired)
' Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
For Each ws In Worksheets
If ws.Name <> "Temp" Then ws.Delete
Next ws
'Folder that holds the workbooks to import
strPath = "c:\\desktop\2010 Budget\Test\"
If Left(strPath, 1) <> "\" Then strPath = strPath & "\"
'List of files to import
strFileName = Dir(strPath & "*.xl*")
'Import Budget sheet with new name from all workbooks
Do While Len(strFileName) > 0
Set wbkOld = Workbooks.Open(strPath & strFileName)
If Evaluate("ISREF(Budget Entry!A1)") Then
Sheets("Budget Entry").Name = "Budget Entry-" & Cnt
Sheets("Budget Entry-" & Cnt).Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
Cnt = Cnt + 1
End If
strFileName = Dir
wbkOld.Close False
Loop

'Delete the temp sheet leaving only budgets
'wbkNew.Sheets("Temp").Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[jbeaucaire]

Multi-word sheet names require a different syntax in a worksheet formula, which is what this line of code is using:

If Evaluate("ISREF('Budget Entry'!A1)") Then

 

[rusted314]

Thank you so much for the fast responses - The syntax issue worked great. I am now getting "a copy method of worksheet class failed" error on this line.

Sheets("Budget Entry-" & Cnt).Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)

 

[jbeaucaire]

At the moment of failure, select DEBUG and see what the values are for Cnt and the current workbook's renamed sheet. They have to match exactly, that message makes me think it can't find the sheet.

 

[ravishankar]

Hi
Save a workbook named rusted.xls in the folder containing budget sheets with the following codes

Sub rusted()
Dim z  As Long, e As Long
Dim f As String, b As String, c As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("rusted.xls").Sheets("Sheet1").Cells(1, 1) = "=cell(""filename"")"
Workbooks("rusted.xls").Sheets("Sheet1").Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Workbooks("rusted.xls").Sheets("Sheet1").Cells(2, 1).Select
f = Dir(Workbooks("rusted.xls").Sheets("Sheet1").Cells(1, 2) & "*.xls")
    Do While Len(f) > 0
    ActiveCell.Formula = f
    ActiveCell.Offset(1, 0).Select
    f = Dir()
    Loop
z = Workbooks("rusted.xls").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For e = 2 To z
         b = Workbooks("rusted.xls").Sheets("Sheet1").Cells(e, 1)
         If b <> ActiveWorkbook.Name Then
        c = Mid(Left(b, Len(b) - 4), 1, 30)
        Workbooks.Open Filename:=Workbooks("rusted.xls").Sheets("Sheet1").Cells(1, 2) & Workbooks("rusted.xls").Sheets("Sheet1").Cells(e, 1)
        Worksheets("Budget summary").UsedRange.Copy'Change sheetname if it is incorrect
        ActiveWorkbook.Close False
        Sheets.Add.Name = c
        Sheets(c).Range("A1").PasteSpecial
        End If
    Next e
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
MsgBox "collating is complete."
End Sub

run the macro. it lists all excel files in the folder and opens each of them, copies budget sheet and pastes as a separate sheet with the filename as sheet name.
ravi

 

[rusted314]

Thank you! This code worked perfectly.