Sub test()
Dim iR&, aa As Range, sh As Worksheet, txt$, a&
Set sh = ActiveSheet
iR = sh.[a1].SpecialCells(xlLastCell).Row
txt = sh.[a1].SpecialCells(xlLastCell).Value
For a = iR To 2 Step -1
  Set aa = sh.Columns(1).Rows(iR)
  If Len(aa) > 0 Then
    If Len(txt) = 0 Then txt = aa
    If Left(aa, 2) <> Left(txt, 2) Then
      txt = aa: sh.Range("A" & iR + 1).EntireRow.Resize(2).Insert
    End If
  End If
  iR = iR - 1
  If iR = 0 Then Exit For
Next
End Sub