Insert rows for multiple selected rows

Hello all,

Can someone modify this code? It does not insert the specified rows in the input box for each selected row, just for one.

Sub test()
  Dim rowcount As Integer
  zeilenanzahl = InputBox("how many rows?")
  Range(ActiveCell, ActiveCell.Offset((rowcount - 1), 0)).EntireRow.Insert
  Cancel = True
End Sub

Best,
JN