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