A Macro that will find all occurance of a keyword and post to new sheet

[chickitaoutlaw]

I have a workbook that is 62000 rows long and contains lots of information including numbers and text. I have been searching all day, and can't seem to search the right phrase to get the answer I need, so please forgive me if this is elsewhere. Basically I would like a macro to search for ALL occurrences of the four different numbers and copy the entire row onto a new sheet. I have found examples that will copy it once, or all occurrences in a specific column, but my numbers could be in any column and I need every time that any of the four different numbers would appear to be copied to one single sheet separate from the rest of the information. ANY HELP APPRECIATED! I have attached an example sheet, that does not use the correct numbers. I'm very VERY knew to this so please use small words with me

So, in the example I would need every time the number 1234567891 appeared anywhere in the sheet, the entire row to be copied to a new sheet except in real life I have four different numbers to search for. example.xls

[AlphaFrog]

You left a lot of ambiguity in your description. Try something like this.

Sub Copy_Matched_KeyWord_Rows()
    
    
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim Found As Range, vKeyWords As Variant, i As Long
    
    Set ws1 = Sheets("Sheet1")  'Data sheet
    Set ws2 = Sheets("Sheet2")  'Destination
    
    vKeyWords = Array("1234567891")
    'Additional vKeyWords like this.
    'vKeyWords = Array("1234567891", "1234567892", "1234567893", "99999999")
    
    For i = LBound(vKeyWords) To UBound(vKeyWords)
        Set Found = ws1.Cells.Find(What:=vKeyWords(i), _
                                   LookIn:=xlValues, _
                                   LookAt:=xlWhole, _
                                   SearchOrder:=xlByRows, _
                                   SearchDirection:=xlNext, _
                                   MatchCase:=False)
        Do While Not Found Is Nothing
            Found.EntireRow.Copy Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1)
            Found.EntireRow.Hidden = True   'Prevent finding this row again
            Set Found = ws1.Cells.FindNext(After:=Found)
        Loop
    Next i
    ws1.Rows.Hidden = False
    
End Sub

[chickitaoutlaw]

PERFECT!!! Thank you so much! Sorry for the ambiguity, I'm working with confidential information and I was really nervous about disclosing anything privileged. Thank you so much though you saved me probably days of work!