XL 2016 Paiement automatique

J'ai trouvé je crois une solution, mais il y a peut-être plus simple étant donné que la feuil1 est en réalité beaucoup plus imposante.

Sub PaiementAutomatique()
Dim Lr As Long ' Parcourir la Feuil1
Lr = Sheets("Feuil1").Range("A60000").End(xlUp).Row
Dim x As Long: Dim y As Long
Sheets("Feuil2").Select

For x = 2 To Range("A60000").End(xlUp).Row
If Cells(x, 4) <= Date And Cells(x, 2) = True Then

For y = 2 To Sheets("Feuil1").Range("A60000").End(xlUp).Row
If Cells(x, 4) <> Cells(y, 1) And Cells(x, 2) <> Cells(y, 4) Then
Lr = Lr + 1
Sheets("Feuil1").Range("A" & Lr) = Cells(x, 4)
Sheets("Feuil1").Range("D" & Lr) = Cells(x, 3)
Exit For
End If

Next y

End If

Next x

End Sub

Bonjour, je croyais avoir trouvé une solution, mais en fait les montants se rajoute plus d'une fois si re-exécute cette procédure.
J'aurais besoin de votre logique s.v.p.
Merci