Need to loop a macro to add salespeople's names and ID numbers

[Surreybloke]

Hi,

I have the beginnings of some code to insert three rows below each row which has a name and ID to then populate those three new blank rows with the name and ID from above. I also have some code in the macro that should identify the end of the data (the first blank row) so that the macro knows to stop.

The bit I'm particularly unsure of is how to incorporate the loop and to tie the whole thing together into something that works.

Any help would be much appreciated. Here is the code so far:

Sub Add_lines()
'
' Add_lines Macro
' Add three extra lines and populate with Name and ID


' Find last row in column A with data
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

' Set range to blank cells in column B
Set Rng = ws.Range("B3:B" & lastRow).SpecialCells(xlCellTypeBlanks)


Rows("3:5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2:B2").Select
Selection.Copy
Range("A3:A5").Select
ActiveSheet.Paste
Range("A6").Select


End Sub

 

[Surreybloke]

I've been doing some additional research and can see how to do the loop, but what I'm not sure of is how to build into the code how to make it go down by four rows from the starting position each time to paste the next three rows and repeat the process?

Do Until IsEmpty(ActiveCell)


Rows("3:5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2:B2").Select
Selection.Copy
Range("A3:A5").Select
ActiveSheet.Paste
Range("A6").Select

Loop

 

[MickG]

Perhaps:-

[COLOR="Navy"]Sub[/COLOR] MG04Apr52
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]For[/COLOR] n = Lst To 2 [COLOR="Navy"]Step[/COLOR] -1
    Range("A" & n).Offset(1).Resize(3).EntireRow.Insert shift:=xlDown
    Range("A" & n).Resize(4, 2).FillDown
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Surreybloke]

Perfect!

That worked like a dream - thank you!

 

[MickG]

You're welcome