Macro for multiple subtotals

Try the attached

Sub test()
    Dim r As Range, i As Long
    Application.ScreenUpdating = False
    Columns("e").Insert
    With Range("d3", Range("d" & Rows.Count).End(xlUp)).Offset(, 1)
        .Formula = "=if(d2<>d3,if(e1=2,""a"",1),"""")"
        .Value = .Value
        On Error Resume Next
        For i = 1 To 2
            .SpecialCells(2, 1).EntireRow.Insert
            .SpecialCells(2, 2).EntireRow.Insert
        Next
        On Error GoTo 0
    End With
    Columns("e").Delete
    With Columns("j").SpecialCells(2, 1)
        For Each r In .Areas
            r(r.Count + 1).Formula = "=subtotal(9," & r.Address & ")"
        Next
    End With
    Application.ScreenUpdating = True
End Sub