Excel VBA to copy and paste an entire row from 1 worksheet to another in the same workbook based on a text

Question

I'm really new to VBA and i will try my best in framing the question well and easy to understand.

Here is my example in Excel with 9 lines/rows:

Hello_update1_@time10
1 Today is a sunny day
2 Today is a good day
Hello_update2_@time20
3 Today is a rainy day
4 Today is a bad day
Hello_update2_@time30
5 Today is a pleasant day
6 Today is a good day

I have already used a code for finding a row with a specific text (for eg: "good") and copying it a new worksheet as shown below. But i need to add a code in which after i find the row with the text "good", the 1st line with "Hello" coming right above the row with "good" also to be copied and pasted in the new worksheet. Like here, the line "Hello_update1_@time10" has to be copied and pasted 1st and then "2 Today is a good day" should come and so on, ie, the final result should be:

Hello_update1_@time10
2 Today is a good day
Hello_update2_@time30
6 Today is a good day

Sub find_good_copy()
    Dim K As Long, r As Range, v As Variant
    K = 2

    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Set w1 = Tabelle1
    Set w2 = Tabelle3

    w1.Activate

    For Each r In Intersect(Range("B:B"), ActiveSheet.UsedRange)
        v = r.Value
        If InStr(v, "good") > 0 Then
            w2.Cells(1, 1) = "good"
            r.EntireRow.Copy w2.Cells(K, 1)
            K = K + 1
        End If
    Next r
End Sub

Tabelle1 and Tabelle3 are the names of the worksheets used. Currently, my output using the above code is:
2 Today is a good day
6 Today is a good day

Thanks.

Answer 1

See changes to code below. Comments explain what I altered and why.

Sub find_good_copy()
    Dim K As Long, r As Range, v As Variant
    K = 2

    Dim w1 As Worksheet, w2 As Worksheet
    Set w1 = Tabelle1
    Set w2 = Tabelle3

    Dim hRow As Integer                     'Declare new variable to keep track of rows
    Dim lRow As Integer        
    h = 2                                   'Set it equal to the first row of your search range

    'Find the last row in a dataset
    lRow = w1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row                

    w1.Activate

    For r = 1 to lRow
        v = w1.Range("A" & r).Value
        If InStr(v, "Hello") > 0 Then       'Check for "Hello"
            hRow = r                        'Found it, save row number
                                            'When it finds the next one, it will save that row number instead
        ElseIf InStr(w1.Range("B" & r).value, "good") > 0 Then
            w2.Cells(1, 1) = "good"
            ws1.Rows(hRow).EntireRow.Copy w2.Cells(K, 1)  'Copy the "Hello" row first
            ws1.Rows(r).EntireRow.Copy w2.Cells(K + 1, 1) 'Copy the row second (need to increase K to copy to next row)
            K = K + 2                       'Need to increase K by 2 instead to account for 2 rows added, not 1
        End If
    Next r
End Sub

This is untested so may require a bit of debugging.