VBA to Split Duplicate rows and change values

[OK2020]

Hello,

I'm trying to write a macro to copy every row which has a value in column C, insert-paste it below it and then change the values in both rows.

I need to go from this:

Product	Hours	Percent Agreed
Apples	10​
Pears	10​	0.5​
Oranges	20​	0.75​

to this

Product	Quantity	Percent Agreed
Apples	10​
Pears	5​	0.5​
Pears	5​	0.5​
Oranges	15​	0.75​
Steve	5​	0.75​

I was thinking something like this, but got stuck:

Option Explicit

Sub Split_Approved_Rows()
Dim i As Integer
i = 2
Dim a As Integer
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Sheet1").Cells(a, 3).Value > 0 Then

Worksheets("Sheet1").Rows(i).Copy

Worksheets("Sheet1").Rows(i + 1).Insert??

End If

Next

End Sub

 

[HongRu]

Try this.

Option Explicit

Sub Split_Approved_Rows()
    Dim i As Integer
    i = 2
    Dim a As Integer
    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For i = a To 2 Step -1
        If Worksheets("Sheet1").Cells(i, 3).Value > 0 Then
            Worksheets("Sheet1").Rows(i).Copy
            Worksheets("Sheet1").Rows(i + 1).Insert Shift:=xlDown
            Worksheets("Sheet1").Cells(i, 2) = Worksheets("Sheet1").Cells(i, 2) * Worksheets("Sheet1").Cells(i, 3)
            Worksheets("Sheet1").Cells(i + 1, 2) = Worksheets("Sheet1").Cells(i + 1, 2) - Worksheets("Sheet1").Cells(i, 2)
        End If
    Next
End Sub