From: Volker Hormuth on
Good morning,
I have found the following solution of Joel.
Nevertheless, I would not like to overwrite the available values in
"Summary", but add to the already available values. How is the code to be
adapted?
Many thanks for every help.
Volker


Sub consolidate()

Set SumSht = Sheets.Add(after:=Sheets(Sheets.Count))
SumSht.Name = "Summary"

NewRow = 2
NewCol = 2
For Each sht In Sheets
If sht.Name <> "Summary" Then

With sht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column

For RowCount = 2 To LastRow
HeaderRow = .Range("A" & RowCount).Value
Set c = SumSht.Columns("A").Find(what:=HeaderRow, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
AddRow = NewRow
SumSht.Range("A" & AddRow).Value = HeaderRow
NewRow = NewRow + 1
Else
AddRow = c.Row
End If

For ColCount = 2 To LastCol
HeaderCol = .Cells(1, ColCount).Value
Data = .Cells(RowCount, ColCount).Value

Set c = SumSht.Rows(1).Find(what:=HeaderCol, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
AddCol = NewCol
SumSht.Cells(1, AddCol).Value = HeaderCol
NewCol = NewCol + 1
Else
AddCol = c.Column
End If

SumSht.Cells(AddRow, AddCol).Value = Data
Next ColCount
Next RowCount
End With
End If
Next sht
End Sub