Sub Macro1()
Dim i As Integer
i = 2
'extrait sans doublons
Range("A1").Copy
Range("P1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
'boucle sur les noms extraits
Do Until IsEmpty(Cells(i, "P"))
Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"P1"), Unique:=True
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Cells(i, "P")
'Aperçu (remplacer PrintPreview par PrintOut pour imprimer)
ActiveWindow.SelectedSheets.PrintPreview
i = i + 1
Loop
End Sub