Sub Transfert()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim n%, h&, ref As Range, c As Range, sup As Range
Application.ScreenUpdating = False
With Feuil2
.Rows("6:" & .Rows.Count).Clear 'RAZ
n = .Cells(3, .Columns.Count).End(xlToLeft).Column - 4
If n < 1 Then Exit Sub 'sécurité
h = Application.Max(5, Feuil1.[A65536].End(xlUp).Row + 1)
Feuil1.[A1].Resize(h, n + 1).Copy .[A6]
Set ref = .[E3].Resize(, n)
For Each c In .[A6].Resize(h)
If c <> "" Then If c <> "EMPLACEMENTS" And Application.CountIf(ref, c) = 0 _
Then Set sup = Union(c.Resize(2), IIf(sup Is Nothing, c.Resize(2), sup))
Next
If Not sup Is Nothing Then sup.EntireRow.Delete
End With
End Sub