Sub TEST_A1()
Dim Arr, Brr, R&, i&, j%, V, S&, X(6)
R = Range("a:e").Find("*", , , , 1, 2).Row
Arr = Range("a2:e" & R + 1)
ReDim Brr(1 To R, 1 To 6)
For i = 2 To R - 1
If Trim(Arr(i, 1)) <> "" Then
X(1) = Trim(Arr(i, 1)): X(2) = Trim(Arr(i, 2)): S = i - 1
For j = 3 To 6: X(j) = 0: Next
End If
X(3) = X(3) - (Trim(Arr(i, 3)) <> ""): X(5) = X(2) / X(3)
X(4) = X(4) - (Trim(Arr(i, 5)) <> ""): X(6) = X(2) / X(4)
If Trim(Arr(i + 1, 1)) <> "" Or i = R - 1 Then
For j = 1 To 6: Brr(S, j) = X(j): Next
End If
Next i
[l3].Resize(R, 6) = Brr
End Sub