Sub Автоматическая_вставка_пустых_строк()

    Dim A(), lr As Long, i As Long
    Dim row As Range
    
    Application.ScreenUpdating = False
        
    'Определяем последнюю строку с данными по столбцу "A".
        'Макрос сделает действие аналогичное тому,
        'как в Excel сделать активной последнюю ячейку
        'в столбце "A" и нажать сочетание
        'клавиш "Ctrl + стрелка вверх".
    lr = Cells(Rows.Count, "A").End(xlUp).row
    A() = Range("A1:A" & lr).Value
            
    For i = UBound(A, 1) To 2 Step -1
        If A(i, 1) <> A(i - 1, 1) Then
            Rows(i).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
            Set row = Rows(i)
            row.Columns("A:E").Interior.Color = 12379352
        End If
    Next i
            
    Application.ScreenUpdating = True
                
End Sub