VBA Cut entire row based on text in cell and paste to new sheet

Question

I am attempting to have VBA scan cells in column DQ for a specific text value of "AcuteTransfer" and then to cut the row containing that cell and past into the first available row of a new sheet.

This value would be listed multiple times and each listing would need to be cut and pasted over

sheet containing the cell is "adds&reactivates" and sheet where row would be pasted to is "ChangeS".

Any recommendations would be amazing.

So far I have

Sub ohgodwhathaveIdone()

Dim endRow As Long
Dim Match1() As Variant
Dim ws As Worksheet
Set ws = Worksheets("adds&reactivates")
ICount = 0
endRow = Sheets("adds&reactivates").Range("DQ999999").End(xlUp).Row

Match1 = Sheet1.Range("DQ2:DQ" & endRow)
For I = LBound(Match1) To UBound(Match1)
If Match1(I, 1) = "AcuteTransfer" Then

    Sheets("adds&reactivates").Cells(I, "A").EntireRow.Copy Destination:=Sheets("changes").Range("A" & Sheets("Changes").Rows.Count).End(xlUp).Offset(1)

    Else
   End If

Next I

End Sub

Answer 1

Try this out - this is assuming both pages have headers on row 1.

Option Explicit
Sub Test()

Dim sht1 As Worksheet, sht2 As Worksheet
Dim i As Long

Set sht1 = ThisWorkbook.Worksheets("adds&reactivates")
Set sht2 = ThisWorkbook.Worksheets("ChangeS")

For i = 2 To sht1.Cells(sht1.Rows.Count, "DQ").End(xlUp).Row
    If sht1.Range("DQ" & i).Value = "AcuteTransfer" Then
        sht1.Range("A" & i).EntireRow.Cut sht2.Range("A" & sht2.Cells(sht2.Rows.Count, "DQ").End(xlUp).Row + 1)
    End If
Next i

End Sub