Sub Вставка()
    Dim i As Long, iLastRow As Long
    Dim SumRow As Long
    With Application
        .ScreenUpdating = False 'не обновляются страницы после каждого действия,увеличение скорости вып. макроса,чтобы вывел значения ПОСЛЕ завершения работы макроса,а не во время
        .Calculation = xlCalculationManual 'для увеличения скорости макроса,пеерводит вычисление формул в ручной режим,а потом снова в автомат.
        iLastRow = Cells(Rows.Count, 5).End(xlUp).Row 'опр.последнюю строчку,по 5 столбцу
        SumRow = iLastRow + 1
        If iLastRow = 1 Then 'на случай если все ячейки пустые,то выводит сообщение об ошибке,но необязательное условие
            MsgBox "Нет данных в столбце E!", vbExclamation, "Ошибка"
            Exit Sub
        End If
            For i = iLastRow To 3 Step -1
                If Cells(i, 5) <> Cells(i - 1, 5) Then 'если значение не ровно предыдущей строчке,то вставляется строка
                    Cells(i, 1).EntireRow.Insert
                    SumRow = SumRow + 1
                    Cells(SumRow, "H").FormulaR1C1 = "=SUM(R[" & i - SumRow + 1 & "]C[0]:R[-1]C[0])"
                    Cells(SumRow, "G").FormulaR1C1 = "=SUM(R[" & i - SumRow + 1 & "]C[0]:R[-1]C[0])"
                    Cells(SumRow, "A").Formula = "=A" & CStr(SumRow - 1)
                    SumRow = i
                End If
            Next i
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    i = 1
    Cells(SumRow, "H").FormulaR1C1 = "=SUM(R[" & i - SumRow + 1 & "]C[0]:R[-1]C[0])"
    Cells(SumRow, "G").FormulaR1C1 = "=SUM(R[" & i - SumRow + 1 & "]C[0]:R[-1]C[0])"
    Cells(SumRow, "A").Formula = "=A" & SumRow - 1
    MsgBox "Пустые строки вставлены!", vbInformation, "Вставка строк"
End Sub

                    Cells(SumRow, "A") = Cells(SumRow - 1, "A")
                    Cells(SumRow, "A").NumberFormat = "dd.mm.yyyy"