Copy & Paste immediate Next Row using VBA

Question

I've a dataset like this format:

 varname  Flag  Status
Product1    Y   
Product2    N   
Product3    N   
Product4    N   
Product5    N   
Product6    N   
Product7    Y   
Product8    Y   
Product9    Y   
Product10   Y   

Now, for any product flag is "Y", then it should enter a row immediately next to it, and copy the row and immediately paste below the row. The new table should look like the following:

varname   Flag  Status
Product1    Y   
Product1    Y   SOLD
Product2    N   
Product3    N   
Product4    N   
Product5    N   
Product6    N   
Product7    Y   
Product7    Y   SOLD
Product8    Y   
Product8    Y   SOLD
Product9    Y   
Product9    Y   SOLD
Product10   Y   
Product10   Y   SOLD

This status should also be updated. I tried the following code. But unfortunately this code could not able to create the table. I'll be grateful if somebody can help me to find the solution.

Sub RegInt2()
    Dim lngRow As Long
    Dim LR As Long
    For lngRow = Worksheets("Sheet1").UsedRange.Rows.Count To 1 Step -1
          LR = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
        If UCase$(Worksheets("Sheet1").Cells(lngRow, 2).Value) = "R" Then
            Worksheets("Sheet1").Range("A" & CStr(lngRow + 1)).Select
            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            End If
            If UCase$(Worksheets("Sheet1").Cells(lngRow, 2).Value) = "R" Then
            Worksheets("Sheet1").Range("A" & LR).Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)


        End If
        Next

End Sub

Answer 1

How about this?

Sub DuplicateSoldProducts()

Dim ProductRange As Range
Dim ProductCell As Range

Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet

'create a new worksheet
Set SourceSheet = Worksheets("Products")
Set TargetSheet = Worksheets.Add

SourceSheet.Select
Range("A1").Select

'put in titles
Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
TargetSheet.Select
TargetSheet.Paste

SourceSheet.Select
Application.CutCopyMode = False

'set reference to block of products
Set ProductRange = Range(ActiveCell, ActiveCell.End(xlDown))

'go through product by product
For Each ProductCell In ProductRange.Cells

    'create row (and maybe copy) on target sheet
    TargetSheet.Select
    ActiveCell.Value = ProductCell.Value
    ActiveCell.Offset(0, 1).Value = ProductCell.Offset(0, 1).Value

    'go to next cell
    ActiveCell.Offset(1, 0).Select

    If UCase(ProductCell.Offset(0, 1).Value) = "Y" Then

        'create copy?
        ActiveCell.Value = ProductCell.Value
        ActiveCell.Offset(0, 1).Value = ProductCell.Offset(0, 1).Value
        ActiveCell.Offset(0, 2).Value = "Sold"

        'go to next cell
        ActiveCell.Offset(1, 0).Select

   End If

Next ProductCell

Range("A1").CurrentRegion.EntireColumn.AutoFit
Range("A1").Select

MsgBox "Done!"

Press F8 to step through line by line to see how it works!