This macro will prompt you for the strings you want to find. After you've finished entering strings, it will copy all the rows that matched any of the strings to Sheet2.
Option Explicit
Sub MultiFindCopy()
'Author: Jerry Beaucaire
'Date: 8/19/2010
'Summary: Prompt for search strings, copy all rows that match the strings
' anywhere to a second sheet for review
Dim findRNG As Range
Dim vFind As Range
Dim vFirst As Range
Dim vStr As String
On Error Resume Next
vStr = Application.InputBox("String to search for:", "Search Data", Type:=2)
With Sheets("Sheet1")
Do
If vStr = "False" Then Exit Do
Set vFind = .Cells.Find(What:=vStr, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not vFind Is Nothing Then
Set vFirst = vFind
Do
If findRNG Is Nothing Then Set findRNG = vFind Else Set findRNG = Union(findRNG, vFind)
Set vFind = .Cells.FindNext(vFind)
Loop Until vFind.Address = vFirst.Address
Set vFind = Nothing
Set vFirst = Nothing
End If
vStr = Application.InputBox("Next String to search for:", "Search Data", Type:=2)
Loop
End With
If findRNG Is Nothing Then Exit Sub
With Sheets("Sheet2")
.Range("A2:A" & Rows.Count).EntireRow.Clear
findRNG.EntireRow.Copy .Range("A2")
End With
Set findRNG = Nothing
Sheets("Sheet2").Activate
End Sub
Bookmarks