Sub CreeClasseurs()
Application.DisplayAlerts = False
[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[g1], Unique:=True
For Each c In Range("G2", Range("G65000").End(xlUp))
Range("G2") = c
Sheets("Modèle").Select
Sheets("BD2").[A1:D10000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("BD2").[G1:G2], CopyToRange:=Sheets("Modèle").[A3:C3], Unique:=False
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("BD2").Select
Next c
End Sub