Code not working
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
|