Creating VBA Macro that Selects certain words and then copies entire row into seperate sheet

[alef1234]

I am trying to create a macro that will look in a particular column (say column A) and search for certain text that I define (such as the word "one day") and if the cell has that words, the macro would slect that entire row and paste the row into a seperate spread sheet. I tried using Active.Cell= but that did not help. Any help is greatly appreciated.

My spreadsheet has about 100 rows that I want the macro to look through.

 

[Sektor]

The general code is as follows - it searches for text "one day". In real world, I guess, you have several words to search - then you'd need to iterate over each one.

Sub FindWords()


    Dim wksSource As Worksheet
    Dim wksTarget As Worksheet
    Dim cell As Range
    
    Set wksSource = Sheets("YOUR_SOURCE_SHEET_NAME")
    Set wksTarget = Sheets("YOUR_TARGET_SHEET_NAME")


    ' The main is xlPart - it searches for incomplete entries (opposite to xlWhole)
    Set cell = wksSource.Columns(1).Find(What:="one day", LookAt:=xlPart)


    ' If cell variable is not nothing then - we've found a cell.
    ' Copy it to target worksheet (in this example - A1 cell).
    If Not cell Is Nothing Then
        cell.Copy wksTarget.Range("A1")
    End If
    
End Sub

 

[alef1234]

This is great. How would I be able to adjust the code so that after is searches and find one set of words I am looking for (one day) and paste into separate sheet, thee macro will go back and look in clomun A for another row that contains some other text (for example maybe (green house) and take the entire row with text that containst green house and paste it into the same sheet but in the following row as we pasted in the row containing "one day" text.

 

[Sektor]

As I said, you'd need to set up a column with the values being searched. Say, it'd be column B. Then B1 will containg one text, B2 - another text etc.
Then the code would look like this:

Sub FindWords()


    Dim wksSource As Worksheet
    Dim wksTarget As Worksheet
    Dim cell As Range
    Dim r, w
    
    Set wksSource = Sheets("YOUR_SOURCE_SHEET_NAME")
    Set wksTarget = Sheets("YOUR_TARGET_SHEET_NAME")


    With wksSource
        'Iterate over each cell with text in colum B
        For r = 1 To Cells(Rows.Count, "B").End(xlUp).Row 'last row in column B
            ' The main is xlPart - it searches for incomplete entries (opposite to xlWhole)
            Set cell = .Columns(1).Find(What:=Cells(r, "B").Value, LookAt:=xlPart)
            ' If cell variable is not nothing then - we've found a cell.
            ' Copy it to target worksheet (in this example - A1 cell).
            If Not cell Is Nothing Then
                w = w + 1 'Shift 1 row down in target sheet
                cell.Copy wksTarget.Cells(w, "A")
            End If
        Next
    End With
    
End Sub

 

[Sektor]

Here's a workbook with example how code works.