ExcelBanter - Copy Data to a new sheet

Oops! The code would have helped!

Sub MoveStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngPaste As Range
Dim strFirstAddress As String

Set rngPaste = Sheets("Results").Cells(Rows.Count,
"A").End(xlUp).Offset(1, 0)
Set rngToSearch = ActiveSheet.Columns("R")
Set rngFound = rngToSearch.Find(What:="Pass", LookIn:=xlFormulas,
LookAt:=xlWhole, MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "There are no items to move."
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress

rngFoundAll.EntireRow.Copy Destination:=rngPaste
End If

End Sub

"JDB" wrote:

Hi,

I am trying to copy data to a new sheet and having some problems.

I need to copy all passes and faileds to a new sheet and work out the
percentage.

Column R contains whether the item is a "Pass" or "Fail" and is
automatically filled in by the formula
=IF(OR(D3="Y",I3="Y",J3="Y",P3="Y",Q3="Y"),"Pass", "Fail").

I have the following code copied from elsewhere on this site, but it does
not work. Returns the message "There are no items to move."!

Also, once complete, how do I assign the macro to a button on the toolbar?

Any help would be gratefully received as it would automate a very laborious
task!

JDB.