Sub TINNER()
Dim a As Integer, x As Integer
Sheets.Add.Name = "summary"
For a = 1 To Sheets.Count
Sheets(a).UsedRange.Copy
x = Sheets("summary").Cells(Rows.Count, 2).End(xlUp).Row + 2
Sheets("summary").Range("A" & x - 1) = Sheets(a).Name
Sheets("summary").Range("B" & x).PasteSpecial
End If
MsgBox "complete"
End Sub