Sub extraire()
chemin = "'C:\monDossier\monSousDossier\" 'à adapter!
Set src = ThisWorkbook.Sheets("cseximpo")
Set liste = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
For lig = 2 To src.Cells(Rows.Count, 3).End(xlUp).Row - 1 '-1 si TOTAL est toujours en toute dernière position en colonne C
liste(src.Cells(lig, 3).Value) = ""
Next lig
For Each k In liste.keys
If Dir(chemin & "ces_extrait_impots_cesximpo_" & k & ".xlsx") <> "" Then _
MsgBox "Un fichier nommé ces_extrait_impots_cesximpo_" & k & vbCr & vbCr & "déjà existant dans " & vbCr & vbCr & "" & chemin & ""
src.[A1].CurrentRegion.AutoFilter Field:=3, Criteria1:=k
ThisWorkbook.Sheets("Modèle").Copy
With ActiveWorkbook
src.[A1].CurrentRegion.Offset(1, 0).Copy .Sheets(1).Cells(3, 1)
.Sheets(1).Cells(.Sheets(1).Cells(Rows.Count, 17).End(xlUp).Row + 1, 1) = "S/T CLE=" & k
.Sheets(1).Cells(Rows.Count, 17).End(xlUp).Offset(1, 0) = Application.Sum(.Sheets(1).Cells(3, 17).Resize(Application.Count(.Sheets(1).[Q:Q]), 1)) / 2
.SaveAs chemin & "ces_extrait_impots_cesximpo_" & k & ".xlsx"
.Close
End With
Next k
src.ShowAllData
Application.ScreenUpdating = True
End Sub