Sub supprimer()
Dim Sht2 As Worksheet, Sh1 As Worksheet
Dim derlign1 As Long, derlign2 As Long, i As Long
Dim c As Range
Application.ScreenUpdating = False
Set Sht2 = Sheets(2)
Sht2.Copy after:=Sht2
derlign1 = Sheets(1).[f65536].End(xlUp).Row
derlign2 = Sht2.[f65536].End(xlUp).Row
i = 2
Do While Cells(i, 6) <> ""
Set c = Sheets(1).Range("f2:f" & derlign1).Find(Cells(i, 6), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Rows(i).EntireRow.Delete
Else
i = i + 1
End If
Loop
Set Sht1 = Sheets(1)
Sht1.Copy after:=Sheets(Sheets.Count)
derlign1 = Sheets(2).[f65536].End(xlUp).Row
derlign2 = Sht1.[f65536].End(xlUp).Row
i = 2
Do While Cells(i, 6) <> ""
Set c = Sheets(2).Range("f2:f" & derlign1).Find(Cells(i, 6), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Rows(i).EntireRow.Delete
Else
i = i + 1
End If
Loop
End Sub