Hi All
New to the forum, please be gentle with me...
Please see the macro below
I found this combine macro found on the internet, it works perfectly on its own
The Macro combines all the files in a particular folder and saves it as one
However, I need it to combine the files in 89 separate folder so I modified it so that it will automatically go through all 89 folders in one go ...but when I loop through this 'List' of files, it works on the first on the list but on the second it refuses to copy the data over to the temp file (it only works on the first on the 'List'), what am I missing???
If you need any more info, please let me know, many many thanks
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
Dim c As Range
For Each c In Range("List")
Workbooks.Open FileName:="G:\Year\All\Book11.xlsx"
'***** Set folder to cycle through *****
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Path = "G:\Year\All\Group\" & c.Value 'Change as needed, ie "C:\"
Windows("Book11.xlsx").Activate
Set aWS = 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 = 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
Windows("Book11.xlsx").Activate
Cells.Select
Selection.ColumnWidth = 8.43
ActiveWorkbook.SaveAs FileName:="G:\Year\All\7 Year\" & Range("A2").Value & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Cells.Select
ActiveWorkbook.Close Savechanges:=False
Next
End Sub
New to the forum, please be gentle with me...
Please see the macro below
I found this combine macro found on the internet, it works perfectly on its own
The Macro combines all the files in a particular folder and saves it as one
However, I need it to combine the files in 89 separate folder so I modified it so that it will automatically go through all 89 folders in one go ...but when I loop through this 'List' of files, it works on the first on the list but on the second it refuses to copy the data over to the temp file (it only works on the first on the 'List'), what am I missing???
If you need any more info, please let me know, many many thanks
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
Dim c As Range
For Each c In Range("List")
Workbooks.Open FileName:="G:\Year\All\Book11.xlsx"
'***** Set folder to cycle through *****
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Path = "G:\Year\All\Group\" & c.Value 'Change as needed, ie "C:\"
Windows("Book11.xlsx").Activate
Set aWS = 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 = 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
Windows("Book11.xlsx").Activate
Cells.Select
Selection.ColumnWidth = 8.43
ActiveWorkbook.SaveAs FileName:="G:\Year\All\7 Year\" & Range("A2").Value & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Cells.Select
ActiveWorkbook.Close Savechanges:=False
Next
End Sub
