Hey,
Here.
It is fairly un-elegant.
Just a bunch of arrays and loops.
There is probably better ways of doing it.
Option Explicit
Sub Loops()
Dim i As Long, ii As Long, j As Long, bot As Long, mbot As Long, rec As Long
ReDim MyGrid(4, 0) As Variant
Sheets("Sheet1").Select
bot = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To 5
mbot = Application.WorksheetFunction.Max(mbot, Cells(Rows.Count, i).End(xlUp).Row)
Next
For i = 2 To bot
j = i + 1
Do Until Cells(j, 1) <> "" Or j = mbot + 1
j = j + 1
Loop
j = j - 1
ReDim Preserve MyGrid(4, UBound(MyGrid, 2) + 1)
rec = UBound(MyGrid, 2)
MyGrid(0, rec) = Cells(i, 1)
For ii = i To j
MyGrid(1, rec) = MyGrid(1, rec) + Cells(ii, 2)
MyGrid(2, rec) = MyGrid(2, rec) + Cells(ii, 3)
MyGrid(3, rec) = MyGrid(3, rec) + Cells(ii, 4)
MyGrid(4, rec) = MyGrid(4, rec) + Cells(ii, 5)
Next
i = j
Next
Sheets("Sheet2").Select
Cells.Clear
bot = Cells(Rows.Count, 1).End(xlUp).Row
For i = 0 To rec
Cells(bot + 1, 1) = MyGrid(0, i)
Cells(bot + 1, 2) = MyGrid(1, i)
Cells(bot + 1, 3) = MyGrid(2, i)
Cells(bot + 1, 4) = MyGrid(3, i)
Cells(bot + 1, 5) = MyGrid(4, i)
bot = bot + 1
Next
End Sub
Bookmarks