Find and Copy
 

I am trying to search for and copy all instances of a found string in
the workbook to another workbook. I found code (not mine, I can't get a
batch file to echo hello) to search and find the string, but don't know
how to get it to write every instance it finds to another new workbook.
Can someone help?

Thanks

Sub FindAcrossMultipleSheets()
Dim findStr As String
Dim wkSht As Worksheet
Dim found As Range
Dim foundAddr As String
Dim yesNoResult As Integer


findStr = InputBox("Find what:", "Find Across Sheets",
ActiveCell.Value)
On Error Resume Next
For Each wkSht In Sheets
With wkSht

'Set found = .Cells.Find(What:=findStr, After:=.Range("A1"), _
MatchCase:=True)

Set found = .Cells.Find(What:=findStr, LookIn:=xlValues, _
Lookat:=xlPart, MatchCase:=False)

'Set cll = .Find(FindString, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)


If Not found Is Nothing Then
foundAddr = found.Address
Do
.Activate
found.Activate
yesNoResult = MsgBox("Find " & findStr & " Again?",
vbYesNo)
If yesNoResult = vbNo Then Exit For
Set found = .Cells.FindNext(After:=ActiveCell)
Loop Until found.Address = foundAddr
Set found = Nothing
End If
End With
Next wkSht
If found Is Nothing Then MsgBox findStr & " not found."
On Error GoTo 0
End Sub

Find and Copy
 

Sub FindAcrossMultipleSheets()
Dim findStr As String
Dim wkSht As Worksheet
Dim found As Range
Dim foundAddr As String
Dim yesNoResult As Integer
Dim destSht as worksheet
Dim i as Long

Set destSht = Workbooks("Output.xls").Worksheets(1)
i = 1
findStr = InputBox("Find what:", "Find Across Sheets",
ActiveCell.Value)
On Error Resume Next
For Each wkSht In Sheets
With wkSht

'Set found = .Cells.Find(What:=findStr, After:=.Range("A1"), _
MatchCase:=True)

Set found = .Cells.Find(What:=findStr, LookIn:=xlValues, _
Lookat:=xlPart, MatchCase:=False)

'Set cll = .Find(FindString, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)


If Not found Is Nothing Then
foundAddr = found.Address
Do
.Activate
found.Activate
found.copy Destination:=destsht.cells(i,1)
i = i + 1
yesNoResult = MsgBox("Find " & _
findStr & " Again?",vbYesNo)
If yesNoResult = vbNo Then Exit For
Set found = .Cells.FindNext(After:=ActiveCell)
Loop Until found.Address = foundAddr
Set found = Nothing
End If
End With
Next wkSht
If found Is Nothing Then MsgBox findStr & " not found."
On Error GoTo 0
End Sub

I had it copy just the cell, but if you want the whole row, change it to

found.EntireRow.copy DestSht.Cells(i,1)

--
Regards,
Tom Ogilvy


"Fred" wrote in message
oups.com...
I am trying to search for and copy all instances of a found string in
the workbook to another workbook. I found code (not mine, I can't get a
batch file to echo hello) to search and find the string, but don't know
how to get it to write every instance it finds to another new workbook.
Can someone help?

Thanks

Sub FindAcrossMultipleSheets()
Dim findStr As String
Dim wkSht As Worksheet
Dim found As Range
Dim foundAddr As String
Dim yesNoResult As Integer


findStr = InputBox("Find what:", "Find Across Sheets",
ActiveCell.Value)
On Error Resume Next
For Each wkSht In Sheets
With wkSht

'Set found = .Cells.Find(What:=findStr, After:=.Range("A1"), _
MatchCase:=True)

Set found = .Cells.Find(What:=findStr, LookIn:=xlValues, _
Lookat:=xlPart, MatchCase:=False)

'Set cll = .Find(FindString, LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)


If Not found Is Nothing Then
foundAddr = found.Address
Do
.Activate
found.Activate
yesNoResult = MsgBox("Find " & findStr & " Again?",
vbYesNo)
If yesNoResult = vbNo Then Exit For
Set found = .Cells.FindNext(After:=ActiveCell)
Loop Until found.Address = foundAddr
Set found = Nothing
End If
End With
Next wkSht
If found Is Nothing Then MsgBox findStr & " not found."
On Error GoTo 0
End Sub

Find and Copy
 

Most helpful.

Thank you very much.