Combine worksheets from several workbooks into one

Posted on 2008-06-24
Last Modified: 2011-12-25
Found a lovely bit of code that will combine all of the worksheets in all of the workbooks in a directory onto a single sheet.  

However, what I'd really like to do is to create a single workbook with a separate worksheet for each of the xls files in a directory.

Is it possible to amend the attached code somehow to make this possible?
Sub CombineSheetsFromAllFilesInADirectory()


    Dim Path As String 'string  variable to hold the path to look through

    Dim FileName As String 'temporary filename string variable

    Dim tWB As Workbook 'temporary workbook (each in directory)

    Dim tWS As Worksheet  'temporary worksheet variable

    Dim mWB As Workbook 'master workbook

    Dim aWS As Worksheet 'active sheet in master workbook

    Dim RowCount As Long 'Rows used on master sheet

    Dim uRange As Range  'usedrange for each temporary sheet


     '***** Set folder to cycle through *****

    Path = "c:\" 'Change as needed


    Application.EnableEvents = False 'turn off  events

    Application.ScreenUpdating = False  'turn off screen updating

    Set mWB = Workbooks.Add(1) 'create a new one-worksheet workbook

    Set aWS = mWB.ActiveSheet 'set active sheet variable to only sheet in mWB

    If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in ""

        Path = Path & Application.PathSeparator 'add ""

    End If

    FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable

    Do Until FileName = "" ' loop until all files have been parsed

        Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable

        For Each tWS In tWB.Worksheets 'loop through each sheet

            Set uRange = tWS.Range("A1", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _

            .Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range

            If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet

                aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns

                Set aWS = mWB.Sheets.Add(After:=aWS) 'add a new sheet that will accommodate data

                RowCount = 0 'reset RowCount variable

            End If

            If RowCount = 0 Then 'if working with a new sheet

                aWS.Range("A1", aWS.Cells(1, uRange.Columns.Count)).Value = _

                tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value 'copy  headers from tWS

                RowCount = 1 'add one to rowcount

            End If

            aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _

            = uRange.Value 'move data from temp sheet to data sheet

            RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly

        Next 'tWS

        tWB.Close False 'close temporary workbook without  saving

        FileName = Dir() 'set next file's name to FileName variable


    aWS.Columns.AutoFit 'autofit columns on last data sheet

    mWB.Sheets(1).Select 'select first data sheet on master workbook

    Application.EnableEvents = True 're-enable events

    Application.ScreenUpdating = True 'turn screen updating back on

End Sub

Open in new window

Question by:Ludique
  • 4
  • 3
LVL 39

Expert Comment

Comment Utility
Do you have multiple sheets in each workbook?

Author Comment

Comment Utility
No just one in each

Author Comment

Comment Utility
Ah but I should mention that while all the workbooks have different names, all of the worksheet have the same name (qselTemp) - they are generated from Access.
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

LVL 39

Accepted Solution

nutsch earned 500 total points
Comment Utility
Try this code from Albert Hammar. Should work for you. Launch from your master workbook

Sub GetSheets()

Dim i As Integer

Dim strPath As String

Dim Otherwb As Workbook


strPath = "C:\PathOf\FolderWithFiles" 'Change this to path of folder with files


Application.ScreenUpdating = False



With Application.FileSearch

       .LookIn = strPath

       .SearchSubFolders = False

       .Filename = "*.xls"

      If .Execute > 0 Then

         For i = 1 To .FoundFiles.Count

               Set Otherwb = Workbooks.Open(.FoundFiles(i), False)

               Otherwb.Sheets(1).Copy After:=Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count)

               Otherwb.Close False

         Next i

      End If

End With


Application.ScreenUpdating = True


Set Otherwb = Nothing



End Sub

Open in new window


Author Comment

Comment Utility

The only tweak is - can it name the worksheets after the workbook they came from rather than their original worksheet name?

Author Comment

Comment Utility
It's OK, Thank you very much.  I can rename the sheets and the cell ranges where applicable once the sheets are all in the one book.

I'm delighted.

Thanks again.
LVL 39

Expert Comment

Comment Utility
Do you have the code for renaming or do you want some help on that?


Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  ( Here (http…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now