Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.
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
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.