Sub CreeClasseurs()
chemin = ActiveWorkbook.Path & "\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets.Add.Name = "transfert"
Sheets("Synthèse GA").Select
Range("A4:A" & Range("A65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"K1"), Unique:=True
Range("J1").Value = "DR"
For Each c In Range("K2", Range("K65000").End(xlUp))
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Range("J2") = c
Sheets("transfert").Select
Sheets("Synthèse GA").Range("A4:G10000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Synthèse GA").Range("J1:J2"), CopyToRange:=Sheets("transfert").Range("A1:G1"), Unique:=False
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=chemin & c
ActiveWorkbook.Close
Sheets("Synthèse GA").Select
Next c
Columns("J:K").Delete Shift:=xlToLeft
Range("A1").Select
Sheets("transfert").Select
ActiveWindow.SelectedSheets.Delete
End Sub