Inserting multiple rows with copy and paste the existing data

Hi

The below code works fine with inserting new rows but I need an extension of the code to incorporate copy and paste function on the existing row data. Please help.

Sub test()
Dim j As Long, r As Range
j = InputBox("type the number of rows to be inserted")
Set r = Range("A2")
Do
Range(r.Offset(1, 0), r.Offset(j, 0)).EntireRow.Insert
Set r = Cells(r.Row + j + 1, 1)
If r.Offset(1, 0) = "" Then Exit Do
Loop

End Sub