Try this:
Sub CollateReportFromFiles()
'Open all .XLS in specific folder (2007 compatible)
Dim strFileName As String, strPath As String, MyVal As String
Dim wbkOld As Workbook, wbkNew As Workbook, ws As Worksheet
Application.EnableEvents = False
Application.DisplayAlerts = False
Set wbkNew = ThisWorkbook
strPath = "C:\Report\"
strFileName = Dir(strPath & "*.xls")
wbkNew.Activate
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
For Each ws In Worksheets
If ws.Name <> "Temp" Then ws.Delete
Next ws
ActiveSheet.Name = "Final"
Do While Len(strFileName) > 0
Set wbkOld = Workbooks.Open(strPath & strFileName)
MyVal = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
wbkOld.Sheets(MyVal & ".xdo").Activate
'Copy After:=wbkNew.Sheets(Sheets.Count)
ActiveSheet.Copy After:=wbkNew.Sheets(wbkNew.Sheets.Count)
strFileName = Dir
wbkOld.Close False
Loop
wbkNew.Sheets("Final").Delete
Application.DisplayAlerts = False
Application.EnableEvents = True
End Sub
This macro can be run and it will update an existing report, too, clearing all the old entries and creating an entirely new compilation report from the noted folder.
Bookmarks