V
Volker Hormuth
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
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