Using VBA scripts to Combine multiple workbooks of single worksheet to a single workbook of multiple worksheets

Excel_beginner

New Member
Joined
Jan 15, 2008
Messages
4
I am a beginner to Excel and VBA, can somebody show me a few lines of scripts and instructions how to use VBA scripts to combine multiple Excel xls Files (which contain single worksheet) into a single Excel file of multiple worksheets?

Can somebody also suggest a good book with examples I can start to learn to solve these kinds of problems?

Thanks very much

Excel_beginner :confused:
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Are these workbooks all stored in the same folder? Are there other workbooks in this folder what will not be combined into one worksheet? If so, you could try this, but I would highly recommend making a complete copy of the folder you are trying to use this one. They both are very similiar and will ask for the directory to copy from. Just copy this into your master workbook and then choose the directory and off you should go.

Version 1 takes all 1st sheets (can have blank rows) and puts into a master workbook.

Code:
'Description: Combines all files in a folder to a master file.
Sub MergeFiles()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer

    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from

    ThisWB = ActiveWorkbook.Name
    
    path = GetDirectory("Select a folder containing Excel files you want to merge")

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
        
        Filename = Dir()
    Loop

    Range("A1").Select
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
End Sub
Version 2 takes all 1st sheets (cannot have blank rows) and puts into a master workbook.

Code:
'Description: Combines all files 1st sheet in a folder to a master file
Sub MergeFilesWithoutSpaces()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer

    ThisWB = ActiveWorkbook.Name
    
    path = GetDirectory("Select a folder containing Excel files you want to merge")
    
    RowofCopySheet = InputBox("Enter Row to start copy on") ' Row to start on in the sheets you are copying from

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
            Set Dest = shtDest.Range("A" & shtDest.Cells(Rows.Count, 1).End(xlUp).Row + 1)
            CopyRng.Copy
            Dest.PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False 'Clear Clipboard
            Wkb.Close False
        End If
        
        Filename = Dir()
    Loop

    Range("A1").Select
    Columns.AutoFit
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
End Sub
Hope that helps. Sorry I don't know of any books to recommend as I have not read any myself. My learning has been through a visual basic class in college and this board and then trial and error. But the class was by far my most help at getting started.
 
Upvote 0
This will combine workbooks with a single sheet into a new workbook with multiple sheets.
Code:
Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\MyPath" ' change to suit
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(MyPath & "\*.xls", vbNormal)
    
    If Len(strFilename) = 0 Then Exit Sub
    
    Do Until strFilename = ""
        
            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
            
            Set wsSrc = wbSrc.Worksheets(1)
            
            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
            
            wbSrc.Close False
        
        strFilename = Dir()
        
    Loop
    wbDst.Worksheets(1).Delete
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Thanks to schielrn, Norie and everyone who helped or looked into this to help.

It turns out that my problem is slightly more complicated, the source Excel files have more than 1 worksheet. But the worksheets I am trying to copy are always the 1st worksheet of a xls file. E.g. I have 10 source xls files, each one of them has 5 worksheets, I am trying to copy the 1st worksheet of each xls file, that results to one single xls file - with 1 workbook of 10 worksheets.

It should be similiar to what schielrn and Norie's codes, but what needs to be change, please suggests.

Thanks very much again.
Excel_beginner
 
Upvote 0
The code I posted should do that.

This creates a reference to the first worksheet.
Code:
Set wsSrc = wbSrc.Worksheets(1)
 
Upvote 0
I don't mean to hijack this thread but I have a similar problem. The code above works great if all of the files are in the same folder. However in my case each file is in a different folder. The folders are named a01, a02, a03, b01, b02, etc. Any ideas? I don't even mind if I have to pick each of the files as this is something I will only have to run once a month. I just need to code to be able to pick a file from a different folder. Any help would be greatly appreciated.

Thanks!
 
Upvote 0
Norie,

Your post is exactly what I am looking for, almost! I had success, but instead of combining into a new workboook, I need to combine into an exisiting workbook if possible.

Thanks,

Danny
 
Upvote 0
Danny

Well if that's the case you need to alter this line.
Code:
Set wbDst = Workbooks.Add(xlWBATWorksheet)
What it does is create a new workbook and a reference to it to use in the subsequent code.

So what you need is something like this.
Code:
Set wbDst = Workbooks("WorkbookToAddSheetsTo.xls")
Obviously you'll need to change the name, and the workbook in question must either be open or you must use code to open it.
 
Upvote 0
The worksheets within the folder are brought into the open workbook, but any sheets within the workbook get delete. Is there a way to keep the existing sheets while bringing in the others?

Danny
 
Upvote 0

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top