Copy and paste row many times by cell value by VBA

[knaabis]

I has simple code like this:
Sub InsertRow()
lastrow = Range("a1").End(xlDown).Row
irow = 2
Do Until irow > lastrow
If Cells(irow, 25).Value = 0.5 Then
Rows(irow + 1).Insert
End If
irow = irow + 1
Loop
End Sub

Need to change the code to, for example: "If Cells (irow, 25) .Value = 3 Then
this row needs to be copied and paste 3 times.

 

[mohadin]

Hi
Try

Sub InsertRow()
    lastrow = Range("a1").End(xlDown).Row
    irow = lastrow
    Do Until irow = 0
        If Cells(irow, 25).Value = 3 Then
            Rows(irow).EntireRow.Copy
      Rows(irow + 1).Resize(3).Insert Shift:=xlDown
        End If
        irow = irow - 1
    Loop
End Sub

 

[knaabis]

Thanks a lot - Mohadin!

 

[mohadin]

You are very welcome
And thank you for the feedback
Be happy and safe