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