none
How to combine sheets of many workbooks into one sheet?

    Question

  • Hi All,

    I'm looking for a handy Excel VBA way of running a macro, and then having it take all of the workbooks in a certain directory (each workbook containing many worksheets), and then VOILA! Something new appears.  All of the workbooks and worksheets are still there, but the new thing that appears is a new workbook, with a worksheet in it that has all of the data from all of the other workbooks (and the worksheets therin).

    All of the worksheets have the same column headings in the same places as each other.

    So it'll be as if I opened each sheet, and copied the sheet  into a new master sheet, and kept opening sheets and copying them below the one I previously copied, workbook after workbook, all into the master file.  I'm currently doing it this manual way and I'll tell you this much, its not fun at all.

    Thanks for any help that can be provided!

    Tuesday, March 08, 2011 2:37 AM

Answers

  • Here's the ULTIMATE ANSWER!!! I haven't tried it out at work yet, but it seems to work on some test files!  Haha all of the notes are there.  Enjoy!  Do you know what this means?  This means that 30mins to 1hr of non-stop copying, for me, has been reduced to a click.  Which also means I'll (or whoever else in the past, and in the future uses this macro) have more mental dexterity throughout the day to spend on things that matter like "google" knowledge hunt-downs and other spur-of-the-moment net research/learning.

     

    Sub CombineSheetsFromAllFilesInADirectory()
         'Uses methods found in http://vbaexpress.com/kb/getarticle.php?kb_id=151 and
         ' http://vbaexpress.com/kb/getarticle.php?kb_id=221
        
        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 = ThisWorkbook.Path & "\subdirectory\" 'Change as needed, ie "C:\"
     
     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
      If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
       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("A2", 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
      End If
      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
     
     'Clear memory of the object variables
     Set tWB = Nothing
     Set tWS = Nothing
     Set mWB = Nothing
     Set aWS = Nothing
     Set uRange = Nothing
    End Sub

    • Marked as answer by fai_013 Thursday, March 10, 2011 3:55 AM
    Thursday, March 10, 2011 3:55 AM

All replies

  • Hmmm...quite interesting.

     

    You can maybe provide a code that links the certain column amongst seperate sheet, and then get it to seperate these values into another master sheet; this is what you are asking, right?

     

    So it would depend on the certain column values. I don't have as much experience with VBA in Excel, so can't help you much.

     

    Interesting topic, though. I will definitely look into this issue.

    Tuesday, March 08, 2011 4:28 AM
  •  

    Depending on your comfort level with VB(A), you may be able to use

    Process all files in a folder and, optionally, in sub-folders
    http://www.tushar-mehta.com/publish_train/xl_vba_cases/process_all_files_in_folder.htm

     

    Hi All,

    I'm looking for a handy Excel VBA way of running a macro, and then having it take all of the workbooks in a certain directory (each workbook containing many worksheets), and then VOILA! Something new appears.  All of the workbooks and worksheets are still there, but the new thing that appears is a new workbook, with a worksheet in it that has all of the data from all of the other workbooks (and the worksheets therin).

    All of the worksheets have the same column headings in the same places as each other.

    So it'll be as if I opened each sheet, and copied the sheet  into a new master sheet, and kept opening sheets and copying them below the one I previously copied, workbook after workbook, all into the master file.  I'm currently doing it this manual way and I'll tell you this much, its not fun at all.

    Thanks for any help that can be provided!


    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    Tuesday, March 08, 2011 7:54 AM
  • I had do this exact thing one time.  All the sheets have common column headings and sheet names.  Excel has a feature to setup a db connection to a workbook using a connect string like this

        ExcelDB.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                     "Data Source=" & dsnWkBook & ";" & _
                     "Extended Properties=Excel 8.0;"

    Once you have the connection setup issue an sql command on the data like

    Select * from Sheet1

    Once you have the recordset paste it into the combined workbook.

    What I like about this method is it does not open the workbook.  It reads the data from disc.  It is very fast.

    It is not difficult but it will take some learning to do it.

     

    Tuesday, March 08, 2011 3:42 PM
  • Hi All,

     

    this is the solution i ended up using.  I open a workbook, run the macro, and it adds up all of the worksheets into a new sheet called MASTER.

     

    i repeat the process of opening up new workbooks, running the macro, and creating MASTER sheets.

     

    Then once that's done, I just go in a manually add up all of the MASTER sheets.

     

    Sub CopyFromWorksheets()
        Dim wrk As Workbook 'Workbook object - Always good to work with object variables
        Dim sht As Worksheet 'Object for handling worksheets in loop
        Dim trg As Worksheet 'Master Worksheet
        Dim rng As Range 'Range object
        Dim colCount As Integer 'Column count in tables in the worksheets
        
        Set wrk = ActiveWorkbook 'Working in active workbook
        
        For Each sht In wrk.Worksheets
            If sht.Name = "Master" Then
                MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
                "Please remove or rename this worksheet since 'Master' would be" & _
                "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
                Exit Sub
            End If
        Next sht
        
         'We don't want screen updating
        Application.ScreenUpdating = False
        
         'Add new worksheet as the last worksheet
        Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
         'Rename the new worksheet
        trg.Name = "Master"
         'Get column headers from the first worksheet
         'Column count first
        Set sht = wrk.Worksheets(1)
        colCount = sht.Cells(1, 255).End(xlToLeft).Column
         'Now retrieve headers, no copy&paste needed
        With trg.Cells(1, 1).Resize(1, colCount)
            .Value = sht.Cells(1, 1).Resize(1, colCount).Value
             'Set font as bold
            .Font.Bold = True
        End With
        
         'We can start loop
        For Each sht In wrk.Worksheets
             'If worksheet in loop is the last one, stop execution (it is Master worksheet)
            If sht.Index = wrk.Worksheets.Count Then
                Exit For
            End If
             'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
            Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
             'Put data into the Master worksheet
            trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        Next sht
         'Fit the columns in Master worksheet
        trg.Columns.AutoFit
        
         'Screen updating should be activated
        Application.ScreenUpdating = True
    End Sub

    • Marked as answer by fai_013 Wednesday, March 09, 2011 10:55 PM
    • Unmarked as answer by fai_013 Thursday, March 10, 2011 3:50 AM
    Wednesday, March 09, 2011 10:55 PM
  • Here's the ULTIMATE ANSWER!!! I haven't tried it out at work yet, but it seems to work on some test files!  Haha all of the notes are there.  Enjoy!  Do you know what this means?  This means that 30mins to 1hr of non-stop copying, for me, has been reduced to a click.  Which also means I'll (or whoever else in the past, and in the future uses this macro) have more mental dexterity throughout the day to spend on things that matter like "google" knowledge hunt-downs and other spur-of-the-moment net research/learning.

     

    Sub CombineSheetsFromAllFilesInADirectory()
         'Uses methods found in http://vbaexpress.com/kb/getarticle.php?kb_id=151 and
         ' http://vbaexpress.com/kb/getarticle.php?kb_id=221
        
        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 = ThisWorkbook.Path & "\subdirectory\" 'Change as needed, ie "C:\"
     
     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
      If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
       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("A2", 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
      End If
      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
     
     'Clear memory of the object variables
     Set tWB = Nothing
     Set tWS = Nothing
     Set mWB = Nothing
     Set aWS = Nothing
     Set uRange = Nothing
    End Sub

    • Marked as answer by fai_013 Thursday, March 10, 2011 3:55 AM
    Thursday, March 10, 2011 3:55 AM
  • Hi Buddy, could guys help me on little bit How to create new sheet automatically every week wise and rename the sheet same date on which day I supposed the refresh the data and send that all sheet to mailed to the concerened persons after refreshing the all sheets with using Macros Anyone plz reply ASAP. Thanx & Regards Ramesh N
    Friday, June 03, 2011 11:22 AM
  • Hi

    I want to know that how to refresh the all excel after save this all worksheet along with daily datewise folders and then apply print command with using in Macro

    Friday, June 03, 2011 11:26 AM
  • this is an old thread, but can someone tell me how add "skip a sheet" in the above code? I have two sheets I dont want to include in the master?


    heads up

    Friday, February 21, 2014 2:56 PM