Sub InsertRow()
Dim i As Long, rCell As Range
    For Each rCell In Selection
        If rCell <> "" Then
            If rCell.Offset(1, 0) <> rCell Then rCell.Offset(1, 0).EntireRow.Insert
        End If
    Next
End Sub

Sub InsertRow()
Dim i As Long, rCell As Range
    For Each rCell In Selection 'Цикл по выделенным ячейкам
        If rCell <> "" Then 'Если текущая ячейка не пуста, то
            If rCell.Offset(1, 0) <> rCell Then rCell.Offset(1, 0).EntireRow.Insert 'Если значение в ячейке "ниже" не равно значению в текущей ячейке, то вставляем строку
        End If
    Next
End Sub