Copying a value from range "H" after inserting rows based on the range "F" value-CodePudding

I found a code that I use to insert rows based on the cell value:

Sub Add_Rows()
  Dim r As Long
  
  Application.ScreenUpdating = False
  For r = Range("F" & Rows.count).End(xlUp).Row To 1 Step -1
    If Cells(r, "F").Value > 0 Then Rows(r   1).Resize(Cells(r, "F").Value).Insert
  Next r
  Application.ScreenUpdating = True
End Sub

But I also need to copy the value of the cell with the same index as "F" into the inserted rows:

How can I modify the code so that rows are inserted based on the value of the range F and a value from the range H is inserted into these rows in parallel?

That is, the script should have logic: if the value of "F" is 2, two rows are inserted - and the value from the index "H" is inserted into these two new rows

In the code that I sent, I manage to insert rows based on the value from the index "F", but I can't supplement the code so that the value from the index H is inserted for each new row

Please tell me how to modify the code? Thanks

CodePudding user response：

Try something like this:

Sub Add_Rows()

  Dim r As Long
  
  Application.ScreenUpdating = False
  
  For r = Range("F" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(r, 5).Value > 0 Then
        Rows(r   1).Resize(Cells(r, 5).Value).Insert
        ' insert h value
        Cells(r   1, 7).Value = Cells(r, 7).Value
    End If
  Next r
  
  Application.ScreenUpdating = True
  
End Sub

CodePudding user response：

I added a line after the .Insert that assigns the value to the "H" column of those new rows. I used the same dynamic range ideas that .Insert used to find the correct range for those new rows.

Sub Add_Rows()
  Dim r As Long
  
  Application.ScreenUpdating = False
  For r = Range("F" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(r, "F").Value > 0 Then
        Rows(r   1).Resize(Cells(r, "F").Value).Insert
        Cells(r   1, "H").Resize(Cells(r, "F").Value).Value = Cells(r, "H").Value
    End If
  Next r
  Application.ScreenUpdating = True
End Sub