Sommer le contenu des cellules qui se suivent

Sub Totaux()
    Dim DerCol As Long, DerLig As Long
    Dim i As Long, j As Long, c As Long
    Application.ScreenUpdating = False
    DerCol = Range("A1").End(xlToRight).Column
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig
        For j = DerCol To 2 Step -1
            c = j
            If Cells(i, j) <> "" Then
                Do
                    Total = Total + Cells(i, c)
                    Cells(i, c) = ""
                    c = c - 1
                Loop While c > 1 And Cells(i, c) <> ""
                Cells(i, j) = Total
            End If
            j = c
            Total = 0
        Next j
    Next i
End Sub