Microsoft 365 insères une ligne après chaque compte avec un sous.total

Option Explicit
Sub inser_SOUS_TOTAL()
'inseser une ligne apres chaque compte avec un sous.total
'Dim Arr As Variant
Dim Sh As Worksheet
Dim LastRow As Long
Dim i As Long, n As Long
Set Sh = ThisWorkbook.Worksheets("Feuil1")
LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
    If Range("A" & i) <> Range("A" & i + 1) Then
        Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A" & i + 1).Value = "Sous Total " & Range("A" & i).Value
        i = i + 1
        LastRow = LastRow + 1
    End If
Next i
End Sub