Hi Kristan,

Try:

'=========================>>
Sub CopySheetFromAll()
   Dim srcWB As Workbook, destWB As Workbook
   Dim sName As String
   Dim MyFiles() As String
   Dim i As Long
   Dim DestSh As Worksheet
   Dim SrcSh As Worksheet
   Dim LRow As Long
   Dim sPath As String
   Dim RngToCopy As Range
   Dim sSaveAsName As String

   sPath = "C:\MYDIR"               '<<==== CHANGE

   sSaveAsName = Application.DefaultFilePath _
               & "\" & "MySummary " & Format _
               (Date, "yyyy-mm-dd") '<<==== CHANGE

   If Right(sPath, 1) <> "\" Then
       sPath = sPath & "\"
   End If

   sName = Dir(sPath & "*.xls")
   If sName = "" Then
       MsgBox "No files found"
       Exit Sub
   End If

   On Error GoTo Cleanup

   Application.ScreenUpdating = False

   Set destWB = Workbooks.Add
   Set DestSh = destWB.Worksheets(1)

   DestSh.Name = "Summary"

   i = 0
   Do While sName <> ""
       i = i + 1
       ReDim Preserve MyFiles(1 To i)
       MyFiles(i) = sName
       sName = Dir()
   Loop

   For i = LBound(MyFiles) To UBound(MyFiles)
       Set srcWB = Workbooks.Open(sPath & MyFiles(i))

       Set SrcSh = srcWB.Sheets("Sheet1") '<<===== CHANGE

       With SrcSh.UsedRange
       On Error Resume Next
           Set RngToCopy = _
           .Offset(1).Resize(.Rows.Count - 1)
       On Error GoTo Cleanup
           If i = 1 Then .Rows(1).Copy DestSh.Cells(1)
       End With

       LRow = LastRow(DestSh)

       If Not RngToCopy Is Nothing Then
           RngToCopy.Copy DestSh.Cells(LRow + 1, 1)
       End If

       srcWB.Close (False)
       Set RngToCopy = Nothing
   Next
   DestSh.Cells(1).Select

   Application.DisplayAlerts = True
   destWB.SaveAs sSaveAsName
Cleanup:
   With Application
       .DisplayAlerts = True
       .ScreenUpdating = True
   End With

End Sub
'<<=========================

'=========================>>
Function LastRow(sh As Worksheet)
'//Function posted by Ron de Bruin
   On Error Resume Next
   LastRow = sh.Cells.Find(What:="*", _
                    After:=sh.Range("A1"), _
                    Lookat:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
   On Error GoTo 0
End Function
'<<=========================

Change the value of sPath to that of the folder holding the files to be
summarised.

If the name of the worksheets to be copied is other than "Sheet1", alter the
Set srcSheet line accordingly.

Change the value of sSaveAsName to a name for the new summary workbook that
suits your purposes.

---
Regards,
Norman