Sub CreeClasseurs()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
[A1:I10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[K1], Unique:=True
For Each c In Range("K2", Range("K65000").End(xlUp))
Range("K2") = c
Sheets("Modèle").Select
[A2:I100].Clear
Sheets("Test").[A1:I10000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Test").[K1:K2], CopyToRange:=Sheets("Modèle").[A1:I1], Unique:=False
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("Test").Select
Next c
End Sub