Hi Bud,

Try this.  It assumes that none of the 100 workbooks are open, and that it will save a Summary.xls to the same directory:

Sub Summarize()

    Dim Counter As Long
    Dim Source As Workbook
    Dim Dest As Workbook

    Const MyDir As String = "c:\temp\"

    Application.ScreenUpdating = False

    For Counter = 1 To 100
        Set Source = Workbooks.Open(MyDir & "Book" & Counter & ".xls")
        If Counter = 1 Then
            Source.Worksheets("Sheet1").Copy
            Set Dest = ActiveWorkbook
        Else
            Source.Worksheets("Sheet1").Copy After:=Dest.Worksheets(Dest.Worksheets.Count)
        End If
        Source.Close False
    Next

    Dest.SaveAs MyDir & "Summary.xls"

    Application.ScreenUpdating = True

    MsgBox "Done"

End Sub


Regards,

Patrick

Hi Bud,

Though Patrick has what I think you're looking for, you could also use something like this to combine all the data into as few sheets as necessary.  Of course this assumes your data all has the same format, but will work regardless:

Option Explicit
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
 Dim LastColm  As Range 'Range variable, will be used to find the last used column
 
  '***** Set folder to cycle through *****
 Path = "C:\temp\" '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
  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 LastColm = aWS.Cells.Find(What:="*", After:=Range("IV1"), _
      SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
     If LastColm.Column <> 255 Then
      aWS.Range(aWS.Columns(LastColm.Column + 1), aWS.Columns(255)).Delete
     End If
     RowCount = aWS.UsedRange.Rows.Count 'Reset scroll bars and last cell
     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
     aWS.Range("IV1").Value = "Source Sheet"
     RowCount = 1 'add one to rowcount
    End If
    With aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count)
     .Value = uRange.Value 'move data from temp sheet to data sheet
     Intersect(.EntireRow, aWS.Columns("IV")).Value = tWS.Name
    End With
    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
 Set LastColm = aWS.Cells.Find(What:="*", After:=Range("IV1"), _
  SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
 If LastColm.Column <> 255 Then
  aWS.Range(aWS.Columns(LastColm.Column + 1), aWS.Columns(255)).Delete
 End If
 RowCount = aWS.UsedRange.Rows.Count 'Reset scroll bars and last cell
 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
 Set LastColm = Nothing
End Sub

Matt

(still give patrick the points for this q)

At the end of his sub (before the done msgbox), put
 For Counter = 1 to Worksheets.Count
  Worksheets(Counter).Name = Counter
 Next

I understand, btw, about the combining of the sheets.. You may want to try it anyways to see how it would work, as it may save a little time.  The routine is one I wrote for something else, so don't feel bad if you don't even try it.  I just wanted to put it here, as it could work for you if certain circumstances existed

Bud,

You're most welcome.

Patrick