Option Explicit
Sub TEST()
If ActiveSheet.Name <> "TEST" Then Exit Sub
Dim n&: n = Cells(Rows.Count, 3).End(3).Row: If n = 2 Then Exit Sub
Dim a&, b&, k&, i As Byte: a = n + 1: Application.ScreenUpdating = 0
With Range("B3:E" & n)
For i = 7 To 11
If i <> 8 Then .Borders(i).LineStyle = 1
Next i
End With
Do
a = a - 1: b = a
Do While IsEmpty(Cells(a, 2)): a = a - 1: Loop
If a > 3 Then Cells(a, 2).Resize(, 4).Borders(8).LineStyle = 1
If a = b Then
Cells(a, 5) = Cells(a, 4)
Else
k = b - a + 1
With Cells(a, 2).Resize(k)
.VerticalAlignment = 2: .Merge
Cells(a, 5) = Application.Sum(.Offset(, 2).Resize(k))
End With
End If
Loop Until a = 3
End Sub