Solved

Combine worksheets from several workbooks into one

Posted on 2008-06-24
7
2,738 Views
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

    Loop

    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

0
Comment
Question by:Ludique
  • 4
  • 3
7 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 21860396
Do you have multiple sheets in each workbook?
0
 

Author Comment

by:Ludique
ID: 21860410
No just one in each
0
 

Author Comment

by:Ludique
ID: 21860422
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.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 39

Accepted Solution

by:
nutsch earned 500 total points
ID: 21860423
Try this code from Albert Hammar. Should work for you. Launch from your master workbook

Thomas
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

0
 

Author Comment

by:Ludique
ID: 21860461
Fantastic!

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

Author Comment

by:Ludique
ID: 21860554
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.
0
 
LVL 39

Expert Comment

by:nutsch
ID: 21860678
Do you have the code for renaming or do you want some help on that?

Thomas
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Excel VBA - Returning results from batch file 9 71
InternetExplorer object in Excel VBA. 4 22
Excel 2016 formulas 5 32
Pivot help - Display only Is Not Null 7 17
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

863 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

25 Experts available now in Live!

Get 1:1 Help Now