Sub Find2()
Dim CompareRange As Variant, xa As Variant, y As Variant
Dim selection
Dim dlig As Long ' dernière ligne
Set CompareRange = Worksheets("Feuil2").Range("A1:a25")
Set selection = Worksheets("Feuil1").Range("b2:b96")
dlig = Worksheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row
For Each xa In selection
For Each y In CompareRange
If xa <> y And xa.Offset(0, 1) <> y.Offset(0, 1) Then xa.Offset(dlig, 0) = y And xa.Offset(dlig, 1) = y.Offset(0, 1) And xa.Offset(dlig, 2) = y.Offset(0, 2) And xa.Offset(dlig, 3) = y.Offset(0, 3) And xa.Offset(dlig, 4) = y.Offset(0, 4)
Next y
Next xa
End Sub