Copy range based on cell value

[shafiq2]

Hi,

I am looking for a vba CODE to copy range (A2) if cell (b2) value is greater than 0, if yes copy range (A2) and paste it in the next empty row and then move to the next row until the last used row.

for example:
If cell (b2) value is 1 then copy range A2 and paste it one time in the next empty row.
if cell (B2) value is 0 then nothing.
if cell (B3) value is 7 then copy range (A3) AND PASTE IT seven TIMES in the next empty row.
If cell (B4) value is 4 then copy range A4 and paste it four times in the next empty row.


As shown in the table below.



Thanks in advance for your help.
Best Regards,
Shafiq

 

[Luke M]

Assuming your data start in row A2 as you stated, this will put the result below current data.

Sub CopyRows()
Dim lastRow As Long
Dim xName As String
Dim xRept As Long
Dim i As Long

Application.ScreenUpdating = False
With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        xRept = .Cells(i, "B").Value
        If xRept > 0 Then
            xName = .Cells(i, 1).Value
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 1).Resize(xRept).Value = xRept
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(xRept).Value = xName
        End If
    Next i
End With
Application.ScreenUpdating = True

End Sub

 

[Marc L]

Hi !

Another way, paste code in worksheet module :​

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False

    For Each Rg In Cells(1).CurrentRegion.Rows
           N& = Val(Rg.Cells(2).Value)
        If N > 0 Then
            With Cells(1).CurrentRegion.Rows
             .Item(.Count).Offset(1).Resize(N).Value = Rg.Value
            End With
        End If
    Next
End Sub

Like it !

Luke, check first ScreenUpdating in your code …​

 

[Luke M]

Thanks Marc, got too fast on the copy & paste there. Corrected above.

 

[shafiq2]

Thank you very much Luke this is exactly what I was looking, but can you please amend the code based on my range. Sorry that I was not clear about the range in the first question.

my range is from A2:I2 and the number is in J column.




Best Regards,
Shafiq

 

[shafiq2]

Thank you marc for the help, this was exactly what I was looking and your code was easier to amend it based my required range.

Best Regards,
Shafiq

 

[Marc L]

Thanks !

A tip when column number is always the last column of the range :​

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False

    With Cells(1).CurrentRegion
      For Each Rg In .Rows
           N& = Val(Rg.Cells(.Columns.Count).Value)
        If N > 0 Then
            With .CurrentRegion.Rows
             .Item(.Count).Offset(1).Resize(N).Value = Rg.Value
            End With
        End If
      Next
    End With
End Sub

 

[shafiq2]

Thanks again Marc.