如果单元格包含特定文本，则复制整行 + 下一行

Question

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:

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

Sheet2 shoud look like this after running script.

A              B                 C                
GradeA     sdfasdf        sadfsadf
Address    sadfas         sdfsadfs 
GradeA     hhh            lll
Address    ppp            hhh

Thank you in advance.

Answer 1

Try the following code

Sub Test()
For Each Cell In Sheets(1).Range("A:A")
    If Cell.Value = "GradeA" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow + 1).Select
        Selection.Copy

        Sheets("Sheet2").Select
        lastRow = ActiveSheet.UsedRange.Rows.Count
        If lastRow > 1 Then lastRow = lastRow + 1
        ActiveSheet.Range("A" & lastRow).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
    End If
Next
End Sub