Cutting and pasting row between sheets

Question

I'm trying to cut a row and paste it if it has the word done in column S.

This is the best I've been able to manage, but it just deletes the row.

Sub TESTMACRO()
'
' TESTMACRO Macro
' CUT LINE PASTE AND SORT

ActiveWorkbook.Sheets("ACTIVE ROYS JOBS").Activate
   
Dim rngA As Range
Dim cell As Range
Set rngA = Range("S1", Range("S65536").End(xlUp))
For Each cell In rngA
    If cell.Value = "DONE" Then
        cell.EntireRow.Cut

        Sheets("COMPLETED JOBS").Select
    
        Sheets("completed jobs").Range("A65536").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
    End If
Next cell

**1.** No need to loop. Use Autofilter as shown in [How to copy a line in excel using a specific word and pasting to another excel sheet?](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s/11633207#11633207) **2.** Once you copy across the data, Simply Delete it from the original sheet :) — Siddharth Rout, Mar 24 '21 at 04:23
Other links worth reading **1.** [Finding Last Row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba) **2.** [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Siddharth Rout, Mar 24 '21 at 04:25

score 0 · Accepted Answer · answered Mar 24 '21 at 04:39

As per @Siddharth Rout's (always) sound advice, the following code will copy - then delete - each row using AutoFilter. Please let me know how you go with it.

Option Explicit

Sub CopyRows()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim LRow As Long, PasteRow As Long

Set ws1 = ThisWorkbook.Worksheets("ACTIVE ROYS JOBS")
Set ws2 = ThisWorkbook.Worksheets("COMPLETED JOBS")

PasteRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1

With ws1.Range("S1").CurrentRegion
    .AutoFilter 19, "DONE"
        LRow = ws1.Cells(Rows.Count, 19).End(xlUp).Row
        If LRow = 1 Then
            MsgBox "No ""DONE"" records found"
            .AutoFilter
            Exit Sub
        End If
    .Offset(1).EntireRow.Copy ws2.Cells(PasteRow, 1)
    .Offset(1).EntireRow.Delete
    .AutoFilter
End With

End Sub

You are a superstar and officially my hero! It works beautifully — QUin, Mar 24 '21 at 05:40
Thank you QUin. Please mark the answer as 'accepted' (click on the big check mark) if it achieves what you want. — , Mar 24 '21 at 05:42

Cutting and pasting row between sheets

1 Answers1