The code looks ok but you have to be careful using lastcell as it is not
necessarilly the first blank cell. Also it will run a bit slower because it
is copying and deleting everytime if finds a match instead of just once at
the end. (Not usually a big deal unless you have a whole pile of lines to
copy).
--
HTH...

Jim Thomlinson


"William Benson" wrote:

> Here's one way ... it looks like a kluge, but fewer lines of code, less
> variables, I think it works ... maybe someone can clean it up if I am using
> an object or two that is not necessary.
>
> Bill Benson
> http://www.xlcreations.com
>
>
> Sub CopyToCompleted()
> Dim rFrom As Range
> On Error Resume Next
> Do While Err.Number = 0
> Set rFrom = Sheets("Project Report").Rows("2:65536").Columns(2).Find _
> (what:="N", LookIn:=xlValues).EntireRow
> If Err.Number <> 0 Then
> GoTo AdvanceLoop
> Else
> With Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell)
> rFrom.Copy
> .Offset(-CInt(Sheets("Completed").UsedRange.SpecialCells(xlCellTypeLastCell).
> _
> EntireRow.Cells(2) <> ""), CInt(.EntireRow.Cells(2) <> "") _
> * (.Column - 1)).Insert shift:=xlDown
> rFrom.Delete shift:=xlUp
> End With
> End If
> AdvanceLoop:
> Loop
> End Sub
>
>
> "GregR" <gregrivet@gmail.com> wrote in message
> news:1122326660.754764.77220@g47g2000cwa.googlegroups.com...
> > 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
> >
>
>
>