Search multiple values in a column and copy found rows plus one row below to a new sheet

Hey Guys!

I am a noob in VBA and I am trying to create a macro which will search for multiple values in a column and will copy the found rows plus the two rows below each found row to a new sheet within the same workbook. Here is how the source sheet looks like:

In this example I will search for words Pear and Blackberry (the search will always be done in Column D) the code has to find the keywords and copy the found row where the words are (there can be thirty Pear and twenty Blackberry keywords in the column and the macro has to be able to loop and find and copy all the words in the column), in this case it's Row4 and Row10 copy I need to copy them plus the copy has to add 2 additional rows below referencing to the found keywords (in this case Rows 4 to 6 and Rows 10 to 12 need to be copied and pasted into a new sheet).

Source:

	A	B	C	D
Row1	1.	Apple	Carrot	Cucumber
Row2				Vegetable
Empty Row3
Row4	2.	Apple	Potato	Pear
Row5				Fruit
Empty Row6
Row7	3.	Melon	Carrot	Potato
Row8				Vegetable
Empty Row 9
Row10	4.	Cherry	Orange	Blackberry
Row11				Berry
Empty Row12

Result:

	A	B	C	D
Row1	1.	Apple	Potato	Pear
Row2				Fruit
Empty Row3
Row4	2.	Cherry	Orange	Blackberry
Row5				Berry
Empty Row6

I found this macro and modified it a bit. It does what I need but it doesn't copy the 2 rows below to the referencing row. Please help me with the code.

Please Login or Register  to view this content.

Thanks a bunch guys!

Amend the line with:-

Rows(x & ":" & x).Select

to :-
Rows(x & ":" & x+2).Select