View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jim Thomlinson[_4_] Jim Thomlinson[_4_] is offline
external usenet poster
 
Posts: 1,119
Default 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