Cut and Paste Row if "X" is in certain cell

[ceereal]

I am trying to create a macro that will cut a whole row if the cell in column K is equal to "Product". The Row that was cut must get pasted onto the next worksheet starting from row 2 onward. Also, I need all the cells from the first worksheet to move up once the row has been cut.

Please help.

Thanks,

 

[alansidman]

Try this:

Option Explicit


Sub DelK()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")
    Dim r1 As Long, r2 As Long
    r1 = sh1.Range("K" & Rows.Count).End(xlUp).Row
    Dim i As Long
    
    Application.ScreenUpdating = False
    For i = r1 To 1 Step -1
    r2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
        If sh1.Range("K" & i) = "Product" Then
        sh1.Range("K" & i).EntireRow.Cut sh2.Range("A" & r2 + 1)
        sh1.Range("K" & i).EntireRow.Delete
        End If
    Next i
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox ("completed")
    
End Sub

 

[NeonRedSharpie]

Sub moveAndDelete()

    Dim start As Worksheet
    Dim dest As Worksheet
    
    Dim nextRow As Long
    nextRow = 2
    
    Set start = Sheets("Sheet11") 'CHANGE ME
    Set dest = Sheets("Sheet12") 'CHANGE ME


    With start
        For x = .Cells(Rows.Count, "K").End(xlUp).Row To 2 Step -1
            If .Cells(x, 11).Value = "Product" Then
                With .Cells(x, 1).EntireRow
                    dest.Cells(nextRow, 1).EntireRow.Value = .Value
                    .Delete
                End With
                nextRow = nextRow + 1
            End If
        Next x
    End With
End Sub

 

[ceereal]

It worked!

Thanks guys!