Добавление строк с пропущенными номерами

Option Explicit
 
Public Sub insert_rows_flat_r()
    Dim rngObj As Range
    Dim i As Integer
    If Selection.Columns.Count <> 14 Then
        MsgBox "Необходимо выделить таблицу!"
        Exit Sub
    End If
    i = 1
    Do
        If Selection.Cells(i, 7).Value <> "" Then
            Set rngObj = Range(Selection.Cells(i + 1, 7), Selection.Cells(Selection.Rows.Count, 7)).Find(what:=(Selection.Cells(i, 7).Value + 1), LookAt:=xlWhole, SearchDirection:=xlNext)
            If rngObj Is Nothing And Application.WorksheetFunction.Max(Selection.Columns(7)) <> Selection.Cells(i, 7).Value Then
                
                Selection.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Selection.Resize(Selection.Rows.Count + 1, Selection.Columns.Count).Select
                Selection.Cells(i + 1, 7).Value = Selection.Cells(i, 7).Value + 1
                Selection.Cells(i + 1, 10).Value = "нежилое"
                Selection.Cells(i + 1, 14).Value = "Не установлено"
                Selection.Rows.Item(i + 1).Interior.ColorIndex = 6
            End If
            Set rngObj = Nothing
        End If
        'If i > 30000 Then Exit Sub
        i = i + 1
    Loop While i <= Selection.Row + Selection.Rows.Count - 1
    Selection.Columns(1).FormulaR1C1 = "=IF(RC[6]<>"""",RC[6],"""")"
End Sub