Copier coller / macro boisgontier

Sub Extrait()
    Set f = Sheets("BD")
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    '--- Liste des services
    f.[a:a].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[Z1], Unique:=True
    For Each c In f.Range("Z2:Z" & f.[Z65000].End(xlUp).Row)   ' pour chaque service
        f.[Z2] = c.Value
        On Error Resume Next
        Sheets(c.Value).Delete
        On Error GoTo 0
        Sheets.Add After:=Sheets(Sheets.Count)   ' création
        ActiveSheet.Name = c.Value
        '-- extraction
        f.[A1:V10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[Z1:Z2], CopyToRange:=[A1]
    Next c
End Sub