Collect all the found cells then paste at one go.

Sub copy_found_Cells()
Dim Cell As Range, tempR As Range, rangeToCheck As Range
'check each cell in the selection
findall = InputBox("Enter a search word")
For Each Cell In Selection
If Cell.Value = findall Then
If tempR Is Nothing Then
'initialize tempR with the first qualifying cell
Set tempR = Cell
Else
'add additional cells to tempR
Set tempR = Union(tempR, Cell)
End If
End If
Next Cell
'display message and stop if no cells found
If tempR Is Nothing Then
MsgBox "There are no cells found " & _
"in the selected range."
End
End If
'select qualifying cells
tempR.Copy Destination:=Sheets("Sheet2").Range("A1")
End Sub


Gord Dibben MS Excel MVP

On Wed, 17 Feb 2010 15:37:01 -0800, Ken
wrote:

Rick, Thanks for responding
I do need to run it as a macro, I've tried capturing the steps using the
find command in excel and highlightling the rows everything looks fine but
when I run the macro it only copies the first cell.
Ken

"Rick Rothstein" wrote:

Does it have to be a macro? You can do what you asked using Excel's Find
option. Click Edit/Find in XL2003 or earlier or
Home/Editing/Find&Select/Find in XL2007, type in the word you are searching
for (you can click the "Options" button to reveal more options for
controlling the search), click the "Find All" button and then press Ctrl+A
to select all the found cells. You can now close the dialog box (the
selected cells will remain selected) and do whatever you want with the
selected cells.

--
Rick (MVP - Excel)


"Ken" wrote in message
...
I am trying to use an Inputbox to enter a search item, find all entries,
highlight all entries, then copy to another sheet using a macro.

Thank you for you help.

.