Comparer des valeurs

Sub unique()
Dim DerligList As Double, DerligFeuil As Double, pl As Range
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("unique").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add.Name = "unique"
DerligList = Sheets("Listing").[A65000].End(xlUp).Row
DerligFeuil = Sheets("Feuil1").[A65000].End(xlUp).Row + 1
Sheets("Listing").Range("A2:G" & DerligList).Copy Sheets("Feuil1").Cells(DerligFeuil, 1)
Set pl = Sheets("Feuil1").Range("A1:G" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
pl.Name = "base"
With Sheets("unique")
            j = 1
    For Each i In Array("PN", "LOT", "EMPLCT")
            .Cells(1, j) = i
        j = j + 1
    Next i
    Range("base").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range( _
        "A1:C1"), unique:=True
    Cells.EntireColumn.AutoFit
End With
With Sheets("Feuil1")
    .Range(.Cells(DerligFeuil + 1, 1), .Cells(DerligFeuil + 1, 7).End(xlDown)).Delete Shift:=xlUp
End With
Range("A1").Select
End Sub