Joel - Data Consolidate Limitation


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
Many thanks for every help.

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
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
AddCol = c.Column
End If

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question