Sub Extrait()
Set bd = Sheets("BD")
bd.Select
'--- Liste des domaines
[A1:J10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[M1], Unique:=True
bd.Select
For Each c In Range("M2", [M65000].End(xlUp)) ' pour chaque service
[M2] = c.Value
On Error Resume Next
Sheets(c.Value).Select ' la feuille existe t-elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = c.Value
End If
'-- extraction
n = Application.CountA(Range("A1:Z1"))
bd.[A1:J10000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=bd.[M1:M2], CopyToRange:=[A1].Resize(1, n)
Bd.select
Next c
End Sub