Insert set number of rows between data and copy and paste data above empty rows

At the minute i use the code below to insert a set number of rows but now i need to be able to copy the data above the inserted blank rows to fill them.

nRows = 23 'number of rows to insert
nEvery = 1 'number of rows to skip between insertions
i = nEvery + 1 'first row for insertion
While Not IsEmpty(Cells(i, 1)) 'stop inserting when come to empty cell
Rows(i & ":" & i + nRows - 1).Insert
i = i + nRows + nEvery
Wend
End Sub

Column A will have this years dates. I need to be able to insert 23 rows in between each date and fill the blanks with the date above the inserted rows.