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