By the way the elegance of 'Set rngCopyFrom = Union(rngCopyFrom,
rngCurrent)' at first escaped me. Nice!

Not knowing much about how Excel performs Union of ranges, I testeted by
filling all 16,777,216 cells with the letter N and searched for N in every
cell. I thought the resulting range would have a whole slew of commas and
blow up but found Excel smartly consolidates the ranges, keeping the most
simplified address. Results shown below. Marvellous.

Iteration Aggregate Range
1 $B$1
2 $B$1:$C$1
....
254 $B$1:$IU$1
255 $B$1:$IV$1
256 $B$1:$IV$1,$A$2
257 $B$1:$IV$1,$A$2:$B$2
....
510 $B$1:$IV$1,$A$2:$IU$2
511 $B$1:$IV$1,$2:$2
512 $B$1:$IV$1,$2:$2,$A$3
513 $B$1:$IV$1,$2:$2,$A$3:$B$3
....
767 $B$1:$IV$1,$2:$3
....
16777214 $B$1:$IV$1,$2:$65535,$A$65536:$IU$65536
16777215 $B$1:$IV$1,$2:$65536 'Note: only
missing A1, but the code will go get it next!
16777216 $A$1:$IV$65536


-- Bill

"Jim Thomlinson" <jamest@tcgiRe-Move-This.com> wrote in message
news:C3869FDE-AEF1-404F-ABE6-B56701A9B8DD@microsoft.com...
> You are close but give this a try...
>
> Public Sub CopyToComlete()
> Dim wksCopyTo As Worksheet
> Dim wksCopyFrom As Worksheet
> Dim rngCopyTo As Range
> Dim rngCopyFrom As Range
> Dim rngToSearch As Range
> Dim rngFirst As Range
> Dim rngCurrent As Range
>
> Set wksCopyTo = Sheets("Completed")
> Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)
>
> Set wksCopyFrom = Sheets("Project Report")
> Set rngToSearch = wksCopyFrom.Columns(2)
> Set rngCurrent = rngToSearch.Find("N")
>
> If rngCurrent Is Nothing Then
> MsgBox "N was not found"
> Else
> Set rngFirst = rngCurrent
> Set rngCopyFrom = rngCurrent
> Do
> Set rngCopyFrom = Union(rngCopyFrom, rngCurrent)
> Set rngCurrent = rngToSearch.FindNext(rngCurrent)
> Loop Until rngFirst.Address = rngCurrent.Address
> rngCopyFrom.EntireRow.Copy rngCopyTo
> rngCopyFrom.EntireRow.Delete
> End If
>
> End Sub
>
> --
> HTH...
>
> Jim Thomlinson
>
>
> "GregR" wrote:
>
>> Why does this code not work?
>>
>> Sub CopyToCompleted()
>> Dim rFrom As Range
>> Dim rTo As Range
>> Dim C As Long 'Column #
>> Dim R As Long 'Row #
>>
>> Set rTo = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp)(1, 1)
>>
>> On Error Resume Next
>> C = [B1].Column
>>
>> Set rFrom = Sheets("Project Report").Range(Cells(3, C),
>> Cells(Rows.Count, C)).Find("N")
>> If Err.Number > 0 Then Exit Sub
>>
>> For Each R In rFrom
>> rFrom.EntireRow.Copy rTo
>> rFrom.EntireRow.Delete
>>
>> Next R
>> End Sub
>>
>> What I am trying to accomplish is move all the rows where column "B" in
>> Sheets("Project Report") ="N" to the next empty row in
>> Sheets("Completed"). TIA
>>
>> Greg
>>
>>