Sub Efface()
Application.ScreenUpdating = 0
Range("D2:D1000").Formula = "=COUNTIF(R2C3:RC[-1],RC[-1])"
Range("A1:D1").AutoFilter
ActiveSheet.Range("$A$1:$D$1000").AutoFilter Field:=4, Criteria1:="<>1"
Range("A2:D1000").EntireRow.Delete
Range("A1:D1").AutoFilter
Columns("D:D").Delete Shift:=xlToLeft
Range("A1").Select
End Sub