Adding row while increasing ID Number by 1 each time

Hello,

I am trying to create a macro that will add a row while increasing the ID number by one each time. For example, there are currently 10 rows with IDs of 1 to 10. When I run the Macro I want to add a row under row 10 and give it the ID of 11. When I run it again I want it to add a row under ID 11 and give it the ID of 12 and so on. My current macro (below) works the first time I run it, adding a row and assigning it the ID of 11, however, when I run it the second time it adds a row but gives it the ID of 11. This should be 12. How do I fix this?

Sub Adduserstory()
'
' Adduserstory Macro
'

'
    Rows("21:21").Select
    Selection.Insert Shift:=xlDown
    Range("A21").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("A22").Select
End Sub