Try this

This example you can use for more words also
See the Array

Sub Union_Examples()
Dim myArr As Variant
Dim FirstAddress As String
Dim Rng As Range
Dim Totrng As Range
Dim I As Long

Application.ScreenUpdating = False
myArr = Array("True")

For I = LBound(myArr) To UBound(myArr)

Set Rng = Range("B:B").Find(What:=myArr(I), After:=Range("B" _
& Rows.Count), LookAt:=xlWhole)
'If you want to search in a part of the rng.value then use xlPart

If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
If Totrng Is Nothing Then
Set Totrng = Rng
Else
Set Totrng = Application.Union(Totrng, Rng)
End If
Set Rng = Range("B:B").FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address < FirstAddress
End If
Next I
If Not Totrng Is Nothing Then
Totrng.EntireRow.Copy Sheets(2).Rows(2)
'Copy to another sheet
End If
Application.ScreenUpdating = True
End Sub



--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"still stuck" wrote in message ...
I got my code working where it copies a row and moves it over to the other sheet, but if I have multiple rows to move over it
only moves the first row that is true, but not the others. How can I get it to move every row that is true over to a new sheet.
Here's my code:

Dim rng As Range, cell As Range, rng1 As Range
Set rng = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp))
Set rng1 = Nothing
For Each cell In rng
If cell.Value = "True" Then
If rng1 Is Nothing Then
Set rng1 = cell
Else
Set rng1 = Union(rng1, cell)
End If
End If
Next
If Not rng1 Is Nothing Then
rng1.Range("B1:H1").Copy Destination:=Worksheets("Sheet2").Range("B2")
End If