Code to insert and copy down

Hi,

I've used the below code to insert a number of lines between each row automatically which works as intended. What i also need to do is copy down the data in the first row at each insert. For example the below 'data' would have 27 rows between each other, but instead of blank cells there is the same number copied down 27 times. Can someone help me with amending the code?

Data:

999253139
999252957

Code:

Sub InsertRows()
Dim i As Long, nRows As Integer, nEvery As Integer
Application.ScreenUpdating = False
nRows = 27 '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

Once i've done that i also want to insert numbers 1-28 in column B againest each row and replicate that at each change.

The final would look like the below:

column A column B
999253139 1
999253139 2
999253139 3
999253139 4
999253139 5
999253139 6
999253139 7
999253139 8
999253139 9
999253139 10
999253139 11
etc
etc

then

999252957 1
999252957 2
999252957 3
etc
etc

Many Thanks

Hi stevedarby02

I believe that you need to add the following code at the end of your code to achieve your desired results

Please Login or Register  to view this content.

Originally Posted by excelxx

Hi stevedarby02

I believe that you need to add the following code at the end of your code to achieve your desired results

Please Login or Register  to view this content.

Fantastic, thank you.

Steve