Copying/Deleting Rows From Sheet To Sheet

[jgarth]

Hello All,

I've done some searching, and am finding bits and pieces of what I need, but can't seem to string anything together for the final product. What I want to do is search one sheet, in column BQ, for the word Complete. If a cell has that word in it, I want to copy that row, paste it into another sheet, and than go back and delete that row, and continue the search until all rows have been searched. Is there a simple way to do this?

I was thinking of an auto filter, but I'm not sure it'd work how I want it based off of what I've read.

Thanks in advance.

 

[jgarth]

Endrow = Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row + 1

I am pretty sure that is all that is needed to find the next available row.

Sub CopyAndDelete() 
    Dim Rng As Range 
    Dim c As Range 
    Dim testvalue 
    testvalue = "Completed" 
    Set Rng = Range("BQ1:BQ" & Range("BQ65536").End(xlUp).Row) 
    Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
    For Each c In Rng 
        If c.Value = testvalue Then 
            c.EntireRow.Copy Sheets("Closed Applications").Range("A" & Endrow) 
            c.EntireRow.Delete 
            Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
        End If 
    Next c 
End Sub

If you have completed 2 rows in a row then it will miss one.


I am quite sure my runs in all my tests properly.

Brian, yours runs well, however it also misses if I have two in a row.

 

[brian.wethington]

Endrow = Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row + 1

I am pretty sure that is all that is needed to find the next available row.

Sub CopyAndDelete() 
    Dim Rng As Range 
    Dim c As Range 
    Dim testvalue 
    testvalue = "Completed" 
    Set Rng = Range("BQ1:BQ" & Range("BQ65536").End(xlUp).Row) 
    Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
    For Each c In Rng 
        If c.Value = testvalue Then 
            c.EntireRow.Copy Sheets("Closed Applications").Range("A" & Endrow) 
            c.EntireRow.Delete 
            Endrow = Sheets("Closed Applications").Range("BQ" & Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row).Row + 1 
        End If 
    Next c 
End Sub

If you have completed 2 rows in a row then it will miss one.


I am quite sure my runs in all my tests properly.

Brian, yours runs well, however it also misses if I have two in a row.

That is not my code, it is John's, I can see where I confused you though... this is the last code I posted.

Option Explicit 
Option Compare Text 
Sub CopyAndDelete() 
Dim c As Long 
Dim Endrow As Long 
Dim testvalue As String 

testvalue = "Completed" 
For c = Sheets("New & Pending Applications").Range("BQ65536").End(xlUp).Row To 1 Step -1 
    If Cells(c, "BQ").Value = testvalue Then 
        Endrow = Sheets("Closed Applications").Range("BQ65536").End(xlUp).Row + 1 
        Sheets("New & Pending Applications").Cells(c, "BQ").EntireRow.Copy Sheets("Closed Applications").Range("A" & Endrow) 
        Sheets("New & Pending Applications").Cells(c, "BQ").EntireRow.Delete 
    End If 
Next c 
End Sub

 

[jgarth]

Works like a charm, thanks so much for your help everyone.