Sub ssTotaux()
Dim c As Range
Dim plage As Range
Dim adr1 As String
    'Copie de travail de la feuille extraction (pour tests)
    Worksheets("Extraction").Copy after:=Sheets(Sheets.Count)
    'Vider la ligne 4
    Range("A4").EntireRow.ClearContents
    'Selectionne la totalité du tableau
     Range("A5").CurrentRegion.Select
    'Création des sous-totaux
    Selection.Subtotal GroupBy:=8, Function:=xlSum, TotalList:=Array(18, 19, 20 _
    , 21, 22, 23), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(18, 19, 20 _
    , 21, 22, 23), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=30, Function:=xlSum, TotalList:=Array(18, 19, _
    20, 21, 22, 23), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    
    'Re sélectionner toutes le tableau
     Range("A5").CurrentRegion.Select
    
    'Rechercher dans la nouvelle plage de donnée la valeur "Total général"
    'Pour en supprimer les lignes
    With Selection
        'Cherche la première cellule contenant l'occurence
        Set c = .Find(what:="Total général", LookIn:=xlValues)
        'Si trouvée
       If Not c Is Nothing Then
           'Retenir son adresse
           adr1 = c.Address
           Do
               'Créer une plage de cellule
               If plage Is Nothing Then 'Pour la première cellule
                Set plage = c
               Else 'Pour les suivantes
                Set plage = Union(plage, c)
               End If
               'Chercher la prochaine occurence
               Set c = .FindNext(c)
           'Boucler tant qu'on est pas retourné à la première cellule trouvée
           Loop While Not c Is Nothing And c.Address <> adr1
       End If
    End With
 'Si une plage de cellule contenant "Total général" a été créee
 'supprimer les lignes correspondantes
 If Not plage Is Nothing Then plage.EntireRow.Delete
End Sub