Excel

Combine All Data From All Worksheets in All Workbooks in a Specified Directory

Ease of Use

Intermediate

Version tested with

2000 

Submitted by:

mvidas

Description:

This code assumes that ALL worksheets in all files have the same field structure; same column headings, and the same column order. It combines them into as many sheets as necessary within the same workbook. 

Discussion:

Suppose you have several workbooks in a directory, each with one or more sheets and you want to put all the worksheets from all the workbooks into one (or more, if necessary) worksheet. This macro does all the work for you. Each worksheet must have the same structure. 

Code:

instructions for use

			

Option Explicit 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

How to use:

  1. Open Excel.
  2. Alt + F11 to open the VBE.
  3. Insert | Module.
  4. Copy the code above and paste into the Code Window that opens up.
  5. Change the Path as needed.
  6. Hit the Save diskette, upper left.
  7. Close the VBE (Alt + Q or press the X in the top right corner).
 

Test the code:

  1. Extract zip file to local drive, a subdirectory will be created with sample files
  2. Open "Create sheets from files.xls" file
  3. Tools | Macro | Macros...
  4. Select CombineSheetsFromAllFilesInADirectory and press Run.
 

Sample File:

Combine sheets from files.zip 24.14KB 

Approved by mdmackillop


This entry has been viewed 536 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2014 VBA Express