Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

wendyc · Mar 16th 2008

Hi,

Any help is greatly appreciated.

I have about 20 workbooks with different file names for different projects all saved in the same folder. Each workbook has about 10 worksheets and each worksheet is named in a similar fashion in each of the 20 workbooks (eg. revenue, cost, variance etc.). I want to pull out a worksheet named 'forecast' from each workbook into a master workbook so that the master workbook would contain the 20 forecast worksheets. Is anyone able to help me with the code to perform this task?

Thanks in advance!

Wendy

jindon · Mar 16th 2008

Re: Combine Multiple Workbooks With Multiple Sheets Into 1 Workbook With Multiple Sheets

try

Code

Sub test()
Dim myDir As String, fn As String
myDir = "c:\test"   '<- change here to actual folder path
fn = Dir(myDir & "\*.xls")
Do While fn <> ""
    With Workbooks.Open(myDir & "\" & fn)
        With .Sheets("forecast")
            .Name = .Name & "(" & fn & ")"
            .Copy Before:=ThisWorkbook.Sheets(1)
        End With
        .Close False
    End With
    fn = Dir
Loop
End Sub

Display More

wendyc · Mar 16th 2008

Re: Combine Multiple Workbooks With Multiple Sheets Into 1 Workbook With Multiple Sheets

Hey,

Thanks for you reply.

I've just tried running it and it only got as far as opening the first workbook saved in the folder. I'll have a closer look at it.

Simon Lloyd · Mar 16th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Wendy, just a couple of additions to Jindon's code (if you don't object Jindon), if you open a workbook and the sheet does not exist then the code will halt with an error, i have added a function and additions to the code to check for this!

Code

Sub test()
    Dim myDir As String, fn As String
    Dim WSName As String
    Dim WB As Excel.Workbook
    WSName = "Sheet1"   ' <-- Change as desired.
    
Application.ScreenUpdating = False
    myDir = "C:\test" '<- change here to actual folder path
    fn = Dir(myDir & "\*.xls")


    Do While fn <> ""
    Set WB = Application.Workbooks.Open(myDir & "\" & fn)
        If MySheetExists(WB, WSName) Then
            'Sheet name exists
        Else
        ActiveWorkbook.Close (False)
            GoTo Nxt
    End If
        With Workbooks.Open(myDir & "\" & fn)
       
            With .Sheets("Sheet1")
                .Name = .Name & "-" & fn
                .Copy Before:=ThisWorkbook.Sheets(1)
            End With
            .Close False
        End With
Nxt:
        fn = Dir
     Loop
     Application.ScreenUpdating = True
End Sub
Public Function MySheetExists(WB As Excel.Workbook, WSName As String) As Boolean
Dim WS As Excel.Worksheet
    On Error Resume Next
    Set WS = WB.Worksheets(WSName)
    MySheetExists = Not (WS Is Nothing)
End Function

Display More

wendyc · Mar 16th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Hi Simon,

Thanks for your help. I tried running the code but keep getting 'subscript out of range'. I haven't had much experience with writing codes and I'm not sure what this means?

Simon Lloyd · Mar 16th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

What error number? did you change the Path in

Code

myDir = "C:\test"

it should be your own path that your folder is in like:

Code

myDir = "C:\Users\Wendy\Documents"

this is how it would look if you were using Windows Vista and the folder you were looking in was "Documents". Also did you change "Sheet1" in the example for the sheet you are looking for?

wendyc · Mar 16th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

I changed the file path and the sheet name I am looking for.

Interestingly, I tested the code on 2 simple workbooks with only 3 worksheets in each and it worked perfectly. But when I try to run it on the 20 workbooks (each workbook with about 10 worksheets) it gives me a error number of 400.

Simon Lloyd · Mar 16th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Are you using Excel 97?
Anyway i have added an error handler maybe it will help!

Code

Sub test()
    Dim myDir As String, fn As String
    Dim WSName As String
    Dim WB As Excel.Workbook
    WSName = "Sheet1" ' <-- Change as desired.
     On Error GoTo Nxt
    Application.ScreenUpdating = False
    myDir = "C:\test" '<- change here to actual folder path
    fn = Dir(myDir & "\*.xls")
     
    Do While fn <> ""
        Set WB = Application.Workbooks.Open(myDir & "\" & fn)
        If MySheetExists(WB, WSName) Then
             'Sheet  name exists
        Else
             ActiveWorkbook.Close (False)
            GoTo Nxt
        End If
        With Workbooks.Open(myDir & "\" & fn)
             
            With .Sheets("Sheet1")
                .Name = .Name & "-" & fn
                .Copy Before:=ThisWorkbook.Sheets(1)
            End With
            .Close False
        End With
Nxt:
        fn = Dir
     Loop
    Application.ScreenUpdating = True
End Sub
Public Function MySheetExists(WB As Excel.Workbook, WSName As String) As Boolean
    Dim WS As Excel.Worksheet
    On Error Resume Next
    Set WS = WB.Worksheets(WSName)
    MySheetExists = Not (WS Is Nothing)
End Function

Display More

wendyc · Mar 17th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Thanks Simon for your help. The code is working pretty well. The only problem is when the macro opens each file in the folder, there is a prompt stating that 'File is already open. Reopening will cause any changes you made to be discarded. Do you want to reopen document?' This prompt pops up for wach of the 20 workbooks in the folder. Can you think of any way to change code below (which is what I'm currently using) so I don't get these pop-ups?

Code

Sub CombineWorkbooks()
    Dim myDir As String, fn As String
    Dim WSName As String
    Dim WB As Excel.Workbook
    WSName = "7. Turnover Projections"
    On Error GoTo Nxt
    Application.ScreenUpdating = False
    myDir = "O:\corp\MA Engineering\PROJECT MANAGEMENT\Project Cost Summaries\2007 - 2008 Project Reports\6.Mar 08"
    fn = Dir(myDir & "\*.xls")
     
    Do While fn <> ""
        Set WB = Application.Workbooks.Open(myDir & "\" & fn)
        If MySheetExists(WB, WSName) Then
             ' Sheet name exists
        Else
             ActiveWorkbook.Close (False)
            GoTo Nxt
        End If
        With Workbooks.Open(myDir & "\" & fn)
             
            With .Sheets("7. Turnover Projections")
                .Name = Mid(fn, 1, 6)
                .Copy After:=ThisWorkbook.Sheets(1)
            End With
            .Close False
        End With
Nxt:
        fn = Dir
     Loop
    Application.ScreenUpdating = True
End Sub
Public Function MySheetExists(WB As Excel.Workbook, WSName As String) As Boolean
    Dim WS As Excel.Worksheet
    On Error Resume Next
    Set WS = WB.Worksheets(WSName)
    MySheetExists = Not (WS Is Nothing)
End Function

Display More

Dave Hawley · Mar 17th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Code

Application.DisplayAlerts=False

You need to set it back to true.

Simon Lloyd · Mar 17th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Thanks Dave, i think it's because there are 2 workbooks.open in there. Wendy Dave's suggestion is to add

Code

Application.DisplayAlerts=False

underneath the DIM statements and then

Code

Application.DisplayAlerts=True

after NEXT

wendyc · Mar 17th 2008

Re: Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Thanks Simon and Dave for your help. It works perfectly now![hr]*[/hr] Auto Merged Post Until 24 Hrs Passes;[dl]*[/dl]Just one more question - Is there a way to incorporate a prompt that allows the user to browse for the folder because the 'myDir' will change each month.

Combine Workbooks With Multiple Sheets Into 1 Multiple Sheet Workbook

Participate now!

Share