Sub Extrait()
Set f = Sheets("BD")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
f.[L1] = f.[A1] ' colonne critère (adapter)
'--- Liste des projets
f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[L1], Unique:=True
For Each c In f.Range("L2:L" & f.[L65000].End(xlUp).Row) ' pour chaque projet
f.[L2] = c.Value
On Error Resume Next
Sheets(CStr(c.Value)).Delete
On Error GoTo 0
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = CStr(c.Value)
'-- extraction
f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[L1:L2], CopyToRange:=[A1:J1]
Next c
f.Select
End Sub