Somme automatique de céllules

Bonjour à tous,

Je suis à la recherche d'une solution VBA qui permettra de faire les sommes automatiquement de céllules dont le(s) céllule(s) de la colonne A sont identiques, selon l'exemple ci-dessous du fichier joint.

Merci d'avance de votre aide.

etesteur

No, 30à59 jrs, 60à89 jrs, 90&P jrs, Total

1000362, 10'133.75, 0.00, 0.00, 10'133.75

1000435, 0.00, 0.00, 860.80, 860.80

1300254, 0.00, 55.00, 0.00,

1300254, 0.00, 1'892.15, 0.00,

1300254, 0.00, 0.00, 2'000.00,

1300254, 0.00, 0.00, 3'288.00,

1300254, 0.00, 0.00, 5'549.40,

1300254, 0.00, 0.00, 7 '290.00,

1300254, 0.00, 0.00, 8'899.40,

1300254, 0.00, 0.00, 8'962.10, 37'936.05

1300410, 0.00, 0.00, 570.30, 570.30

1500042, 2'152.00, 0.00, 0.00,

1500042, 14'203.20, 0.00, 0.00,

1500042, 0.00, 0.00, 918.00,

1500042, 0.00, 0.00, 3'510.00, 20'783.20

1500049, 1'721.60, 0.00, 0.00,

1500049, 6'456.00, 0.00, 0.00,

1500049, 0.00, 0.00, 918.00,

1500049, 0.00, 0.00, 3'510.00, 12'605.60

1500090, 0.00, 0.00, 3'240.00, 3'240.00

Bonjour,

Sub SousTotaux()
Dim Lg&, i%, x%
Dim firstAddress$, c As Range
        Application.ScreenUpdating = False
        Lg = Range("a" & Rows.Count).End(xlUp).Row
    For i = 2 To Lg
        With Columns("a")
            Set c = .Find(Cells(i, "a"), LookIn:=xlValues, lookat:=xlPart)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    x = Range(c.Address).Row
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
                '--- total ---
                Cells(x, "e") = "=SUM(b" & i & ":d" & x & ")"
                i = x
            End If
        End With
    Next i
End Sub

Amicalement

Claude

Merci infiniment Claude, ça marche impeccablement!

Cordialemet!

etesteur