Sub Moyenne()
Dim Lg&, i%, x%
    Application.ScreenUpdating = False
    Lg = Range("a" & Rows.Count).End(xlUp).Row

    'Tri par pièce
   Range("a2:d" & Lg).Sort _
        Key1:=Range("B2"), Order1:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    'Algorithme:
   For i = 2 To Lg
        If Cells(i + 1, "A") = Cells(i, "A") Then
           If Cells(i + 1, "C") = Cells(i, "C") Then
            x = i
            Do While Cells(x + 1, "B") = Cells(i, "B")
               Do While Cells(x + 1, "C") = Cells(i, "C")
                 Cells(i, "D") = (Cells(i, "D") + Cells(x + 1, "d"))/2
	         Cells(i, "E") = (Cells(i, "E") + Cells(x + 1, "E"))/2
                 Cells(x + 1, "a").ClearContents
                 x = x + 1
               Loop
            Loop
            i = x
           End If
        End If
    Next i
        On Error Resume Next
    Range("a2:a" & Lg).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub