Dim rngNew As Excel.Range
Set rngNew = Cells(Rows.Count, "A").End(xlUp).Offset(1)
rngNew.Value = 2
Dim rngCell As Excel.Range
For Each rngCell In Range("A1", rngNew.Offset(-1))
If rngCell.Value >= rngNew.Value Then
rngCell.Value = rngCell.Value + 1
End If
Next