Public Function SubTotals()
  Dim LastCell As Integer
  Dim lp As Integer
  Dim FirstCell As Integer
  
  LastCell = Selection.SpecialCells(xlCellTypeLastCell).Row
  Range("A1").Select
  For lp = 1 To LastCell + 1
    If Range("A" & lp) = "" And FirstCell > 0 Then
      Range("A" & lp).FormulaR1C1 = "=SUM(R[-" & lp - FirstCell & "]C:R[-1]C)"
      FirstCell = 0
    Else
      If Range("A" & lp) <> "" And FirstCell = 0 Then FirstCell = lp
    End If
  Next lp
End Function