Sub SousTotal()
Dim plage As Range, cel As Range
Application.ScreenUpdating = False
Set plage = Range("B1", [B65536].End(xlUp))
plage.AutoFilter 1, "<>1"
Set plage = plage.Offset(1).SpecialCells(xlCellTypeVisible)
ActiveSheet.AutoFilterMode = False
Set plage = Intersect(plage.EntireRow, [C:C])
[C2:C65536].ClearContents 'RAZ
For Each cel In plage
cel.FormulaArray = "=SUM(OFFSET(R1C2,MAX(IF(R1C2:R[-1]C2<>1,ROW(R1C2:R[-1]C2)))-1,):R[-1]C2)"
'cel = cel 'facultatif, supprime la formule
Next
End Sub