copier/coller sous conditions

Sub somme()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim s As Double 'déclare la variable s (Somme)
Dim dest As Range 'déclare la variable dest (DESTination)
 
Set pl = Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row) 'définit la plage pl
 
For Each cel In pl 'boucle sur toutes les cellules éditées cel de la plage pl
    s = 0 'définit la variable s
    If cel.Font.ColorIndex <> 5 Then 'condition 1 : si l'encre de la cellule n'est pas bleue
 
        'condition 2 : si le nombre de valeur de la cellule dans la plage pl est supérieur à un
        If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
            Set r = pl.Find(cel.Value, , xlValues, xlWhole) 'définit la variable r
            If Not r Is Nothing Then pa = r.Address 'si il existe au moins une occurrence de r dans pl définit la variable pa
            r.Font.ColorIndex = 5 'met l'encre bleue dans l'occurrence trouvée
            Do 'exécute
                Set r = pl.FindNext(r) 'redéfinit la variable r (prochaine occurrence)
                s = s + CDbl(r.Offset(0, 1).Value) 'redéfinit la variable s
                r.Font.ColorIndex = 5 'met l'encre bleue dans la nouvelle occurrence
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
        Else 'sinon (condition 2)
            s = CDbl(cel.Offset(0, 1).Value) 'définit la variable s
        End If 'fin de la condition 2
 
        Set dest = Sheets("Feuil1").Range("D65536").End(xlUp).Offset(1, 0) 'définit la variable dest
        dest.Value = cel.Value 'récupère le numéro OF
        dest.Offset(0, 1).Value = s 'récupère la somme
 
    End If 'fin de la condition1
Next cel 'prochaine cellule de la plage
pl.Font.ColorIndex = 1 'remet la couleur d'encre noire dans la plage pl
End Sub