Modifier macro pour extraire par filtre élaboré...

Sub extrait()
Dim P As Range, nomOnglet$, ZoneCritere As Range
Set P = Cells.Find("Nom", , xlValues).CurrentRegion
If Intersect(ActiveCell, P) Is Nothing Then Exit Sub
nomOnglet = CStr(ActiveCell)
Set ZoneCritere = P(1, P.Columns.Count + 1).Resize(2)
ZoneCritere(1) = Intersect(P.Rows(1), ActiveCell.EntireColumn)
ZoneCritere(2) = ActiveCell
Application.DisplayAlerts = False
On Error Resume Next
Sheets(nomOnglet).Delete
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = nomOnglet
P.AdvancedFilter xlFilterCopy, ZoneCritere, Sheets(nomOnglet).[A1]
ZoneCritere = ""
End Sub