Search for specific test and copy row+next row to new sheet

[namilo786]

I am really new with VBS and need help.
I have sheet1 and sheet2. All my raw data is in sheet1 column A and sheet2 will be summary report. I want my script to search each cell in column A and search for "Grade A". If find, copy entired row which contains Grade A word and also copy next row and paste it in sheet2. Here is an example.
Sheet1:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
A-B-C
GradeA-sdfasdf-sadfsadf
Address-sadfas-sdfsadfs
Grade B-sadfsd-dgfdsgdf
Address-sdfasf-ertertewt
Grade C-fhgfdgh-ukjtyuyt
GradeA-hhh-lll
Address-ppp-hhh
<o></o>
Sheet2 shoud look like this after running script.
<o></o>
A-B-C
GradeA-sdfasdf-sadfsadf
Address-sadfas-sdfsadfs
GradeA-hhh-lll
Address-pp-hhh

<o></o>
This is what I have so far but this scrip does not loop. It only copies first found entry.

<o></o>
Sub testme()
Dim FoundCell As Range
<o></o>
With Worksheets("Sheet1")
Set FoundCell = .Cells.Find(What:="*GradeA*", _
After:=.Cells(.Cells.Count), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
<o></o>
If FoundCell Is Nothing Then
MsgBox "Not found"
Else
FoundCell.Resize(2, 1).EntireRow.Copy
Sheet2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
<o></o>
End If
End Sub

 

[Tinbendr]

On a blank line type in range.find, then press F1. Select Range.Find Method.

Look at the example provided.