Sub Data_to_Summary()
Dim w As Long
Dim x As Long
Dim y As Long
Dim wSummary As Worksheet: Set wSummary = Sheets("Summary")
Application.ScreenUpdating = False
For w = 1 To Worksheets.Count
With Sheets(w)
If .Name <> wSummary.Name Then
x = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
y = .Cells(1, .Columns.Count).End(xlToLeft).Column
wSummary.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(x, y).Value = .Cells(2, 1).Resize(x, y).Value
If w = Worksheets.Count Then wSummary.Cells(1, 1).Resize(, y) = .Cells(1, 1).Resize(, y).Value
End If
End With
Next w
Application.ScreenUpdating = True
Set wSummary = Nothing
End Sub