Loop and copy paste part numbers based on qty

[rajkumar]

hi

i want to copy paste part numbers based on its qty to adjacent columns

please help with vba code for it, in the attached picture part number last digit become incremented, since i dragged to copy. part number should remain same in column A as well as in copied places

regards
raj


21845

[YasserKhalil]

Hello Raj
Try this code


Sub Test()
Dim c As Range


With Cells(1).CurrentRegion
With .Offset(1).Resize(.Rows.Count - 1)
For Each c In .Columns(7).Cells
If IsNumeric(c.Value) And c.Value > 1 Then
c.Offset(, -5).Resize(, c.Value - 1).Value = c.Offset(, -6).Value
End If
Next c
End With
End With
End Sub

[rajkumar]

Hello Raj
Try this code


Sub Test()
Dim c As Range


With Cells(1).CurrentRegion
With .Offset(1).Resize(.Rows.Count - 1)
For Each c In .Columns(7).Cells
If IsNumeric(c.Value) And c.Value > 1 Then
c.Offset(, -5).Resize(, c.Value - 1).Value = c.Offset(, -6).Value
End If
Next c
End With
End With
End Sub


Hi YasserKhalil

thanks for your reply
this table is in a middle of a worksheet, i am attaching a sample
please support

218462184621846

[YasserKhalil]

Try this modification


Sub Test()
Dim c As Range


With Range("H1:O" & Cells(Rows.Count, "H").End(xlUp).Row)
With .Offset(1).Resize(.Rows.Count - 1)
For Each c In .Columns(8).Cells
If IsNumeric(c.Value) And c.Value > 1 Then
c.Offset(, -6).Resize(, c.Value - 1).Value = c.Offset(, -7).Value
End If
Next c
End With
End With
End Sub

[rajkumar]

Try this modification


Sub Test()
Dim c As Range


With Range("H1:O" & Cells(Rows.Count, "H").End(xlUp).Row)
With .Offset(1).Resize(.Rows.Count - 1)
For Each c In .Columns(8).Cells
If IsNumeric(c.Value) And c.Value > 1 Then
c.Offset(, -6).Resize(, c.Value - 1).Value = c.Offset(, -7).Value
End If
Next c
End With
End With
End Sub



thanks perfectly working

[YasserKhalil]

You're welcome. Glad I can offer some help