Sub Macro1()
Dim ws As Worksheet
Dim wsInfo As Worksheet
Set wsInfo = ActiveWorkbook.Sheets(1)
Dim Counter As Integer
Counter = 1
For Each ws In ActiveWorkbook.Sheets
Dim columnCounter As Integer
Dim wsColumnCounter As Integer
columnCounter = 2
wsInfo.Cells(Counter, "A").Value = ws.Name
wsColumnCounter = 1
Do While ws.Cells(1, i) <> ""
wsInfo.Cells(Counter, columnCounter).Value = ws.Cells(1, wsColumnCounter)
columnCounter = columnCounter + 1
wsColumnCounter = wsColumnCounter + 1
Loop
Counter = Counter + 1
Next
End Sub
