supprimer ligne

Sub test()
Dim ligne As Integer
Dim tablo()
ReDim tablo(1)
Dim col As Collection
Set col = New Collection
On Error Resume Next
For n = 1 To Range('D65536').End(xlUp).Row
col.Add Sheets('Feuil1').Range('D' & n), CStr(Range('D' & n))
Next n
On Error GoTo 0
For n = 1 To col.Count
  For x = 1 To Sheets('Feuil1').Range('D65536').End(xlUp).Row
   If col(n) = Sheets('Feuil1').Range('D' & x) Then
      tablo(UBound(tablo)) = x
      ReDim Preserve tablo(UBound(tablo) + 1)
      Exit For
   End If
  Next x
Next n
ligne = 1
For n = 1 To UBound(tablo) - 1
Sheets('Feuil1').Range('A' & tablo(n) & ':H' & tablo(n)).Copy Destination:=Sheets('Feuil2').Range('A' & ligne) ' & ':H' & ligne)
ligne = ligne + 1
Next n
End Sub

Sub test()
Dim ligne As Integer
Dim tablo()
ReDim tablo(1)
Dim col As Collection
Set col = New Collection
On Error Resume Next
For n = 1 To 4000
col.Add Sheets('Feuil1').Range('D' & n), CStr(Range('D' & n))
Next n
On Error GoTo 0
For n = 1 To col.Count
  For x = 1 To 4000
   If col(n) = Sheets('Feuil1').Range('D' & x) Then
      tablo(UBound(tablo)) = x
      ReDim Preserve tablo(UBound(tablo) + 1)
      Exit For
   End If
  Next x
Next n
ligne = 1
For n = 1 To UBound(tablo) - 1
Sheets('Feuil1').Range('A' & tablo(n) & ':H' & tablo(n)).Copy Destination:=Sheets('Feuil3').Range('A' & ligne) ' & ':H' & ligne)
ligne = ligne + 1
Next n
End Sub

Sheets('Feuil1').Range('A4000:H' & Sheets('Feuil1').Range('A65536').End(xlUp).Row).Copy Destination:=Sheets('Feuil3').Range('A' & ligne + 1)