Sub SousTotaux3()
Dim i As Long
Dim Iprec As Long
Dim strNom, strNom2 As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'i = 2
NbLignes = Range("A" & Rows.Count).End(xlUp).Row
'Boucle sur tant que la colonne A n'est pas vide
For i = NbLignes To 2 Step -1
'Si nom de la ligne <> du nom precedent
j = i
While Range("A" & j).Value = Range("A" & i).Value And Range("C" & j).Value = Range("C" & i).Value
j = j - 1
Wend
Rows(i + 1).Insert
Range("E" & i + 1).FormulaLocal = "=somme(E" & j + 1 & ":E" & i & ")"
Range("F" & i + 1).FormulaLocal = "=somme(F" & j + 1 & ":F" & i & ")"
Range("G" & i + 1).FormulaLocal = "=somme(G" & j + 1 & ":G" & i & ")"
Range("H" & i + 1).FormulaLocal = "=somme(H" & j + 1 & ":H" & i & ")"
Range("I" & i + 1).FormulaLocal = "=somme(I" & j + 1 & ":I" & i & ")"
'Ajoute le nom en B et C
Range("A" & i + 1).Value = Range("A" & j + 1).Value
Range("C" & i + 1).Value = Range("C" & j + 1).Value
Range("A" & i + 1 & ":I" & i + 1).Font.Bold = True
'Regroupe les lignes et les fusionnes
Rows(j + 1 & ":" & i).Group
Range("C" & j + 1 & ":C" & i + 1).Merge
i = j + 1
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub