Excel - Insertar filas cuando en una columna aparece un numero mayor a 1

Option Explicit

Sub test()

Dim rng As Range

Dim i%

Set rng = Range("a1")

i = 0

Do While rng.Offset(i).Value <> ""

   If rng.Offset(i).Value > 1 Then

      i = i + 1

      rng.Offset(i).EntireRow.Insert

   End If

   i = i + 1

Loop

End Sub

Sub InsertarFilas()

Dim Rng As Range, Vec, Q&, i&, r1&, P&

Set Rng = Range([b3], [b2].End(xlDown))

Q = Rng.Count: r1 = Rng(1).Row

Cells(r1, "aa") = r1

With Cells(1 + r1, "aa").Resize(Q - 1)

  .Formula = "= aa" & r1 & " + 1 + (" & Rng(1).Address(False, False) & ">1)"

  .Value = .Value

End With

Vec = Cells(r1, "aa").Resize(Q)

For i = 2 To Q

  If Vec(i, 1) - Vec(i - 1, 1) > 1 Then

    P = 1 + P

    Vec(P, 1) = Vec(i, 1) - 1

  End If

Next

Cells(r1, "aa").Offset(Q).Resize(P) = Vec

Range(Rng(1), Cells(r1 + Q + P - 1, "aa")).Sort _

  key1:=Cells(r1, "aa"), order1:=xlAscending, Header:=xlNo

Columns("aa").Delete

Set Rng = Nothing: Vec = Empty

End Sub