Macro: supprimer des lignes en les additionnants

Bonjour,

J'aimerais avoir une macro qui supprimerais des lignes identiques mais ayant des montants différents en les additionnants. (colonne montant et unitaire) Je vous joint un fichier en exemple.

Merci

Bonsoir et bienvenue,

Sub Compile()
Dim Lg&, i%, x%
    Application.ScreenUpdating = False
    Lg = Range("a" & Rows.Count).End(xlUp).Row
    '--- tri colonne B---
    Range("a2:f" & Lg).Sort _
        Key1:=Range("b2"), Order1:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    '---
    For i = 2 To Lg
        If Cells(i + 1, "b") = Cells(i, "b") Then
            x = i
            Do While Cells(x + 1, "b") = Cells(i, "b")
               Cells(i, "d") = Cells(i, "d") + Cells(x + 1, "d")
               Cells(i, "e") = Cells(i, "e") + Cells(x + 1, "e")
               Cells(x + 1, "a").ClearContents
               x = x + 1
            Loop
            i = x
        End If
    Next i
        On Error Resume Next
    Range("a2:a" & Lg).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Amicalement

Claude

Merci beaucoup !!!

N'oublie pas la petite formalité