VBA if cell value>0 copy this row & insert row under

[dstramilov]

I need to create VBA that will insert & copy current row if value in column D>0 & do this all the the way to the end.
I need VBA that will work as VLOOKUP but for multilines. Let's say A7="Paris" Sheet1. I need to copy a all values (if A7="Paris") from sheet2 column B, C, D etc.

 

[onlyadrafter]

Hello,

here is code for the first part

Sub COPY_CURRENT_ROW()
    Application.ScreenUpdating = False
    For MY_ROWS = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        If Range("D" & MY_ROWS).Value > 0 Then
            Rows(MY_ROWS).Copy
                Rows(MY_ROWS + 1).Insert
        End If
    Next MY_ROWS
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

does this work as expected?

Don't quite understand your second question.

 

[dstramilov]

Thank you, It worked perfectly!

For second question:
Sheet1:
A2 = "Piter Pen"

Sheet2 I got 1000 rows of data with 5-8 column.
I need to copy all rows from sheet2 to sheet 1 column B:F, if value in column A sheet 2 = "Piter Pen", paste data to sheet1 B2 & down/right all the way.
It is type of vlookup function, but vlookup can't copy multilines for the same value.

 

[onlyadrafter]

Hello,

does this work as expected?

Sub COPY_CURRENT_ROW()
    Application.ScreenUpdating = False
    For MY_ROWS = 2 To Sheets("Sheet2").UsedRange.Rows.Count
        With Sheets("Sheet2")
        If .Range("A" & MY_ROWS).Value = "Piter Pen" Then
            .Range("B" & MY_ROWS & ":F" & MY_ROWS).Copy
                Sheets("Sheet1").Range("B" & Sheets("Sheet2").Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlValues)
        End If
        End With
    Next MY_ROWS
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[dstramilov]

It did, thank you!

But I need some extra modification please. http://awesomescreenshot.com/0063ngg4b2

Did you understand second question?