Thanks so much, Bob. It works.

Quote Originally Posted by Bob Phillips View Post
Public Sub AddRows()
Dim lastrow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = lastrow To 5 Step -1
        
            .Rows(i + 1).Resize(2).Insert
            .Cells(i, "B").Resize(3).Value = .Cells(i, "B").Value
        Next i
    End With

    Application.ScreenUpdating = True
End Sub