Option Explicit
Sub Comparaison()
Dim i, j, k As Long
Dim Plage1, Plage2 As Range
Dim Cell1, Cell2 As Object
k = 2
i = Sheets(1).Range("A65536").End(xlUp).Row
j = Sheets(1).Range("D65536").End(xlUp).Row
Sheets(1).Range("G2:G1000").ClearContents
Set Plage1 = Sheets(1).Range("A3:A" & i)
Set Plage2 = Sheets(1).Range("D3:D" & j)
For Each Cell1 In Plage1
Set Cell2 = Plage2.Find(What:=Cell1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Cell2 Is Nothing Then
If Cell1.Offset(0, 1).Value > Cell2.Offset(0, 1).Value Then
Sheets(1).Range("G" & k).Value = Cell2.Value
k = k + 1
End If
End If
Next Cell1
End Sub