Cut and Paste Macro

Guys,

I need some help again. I just need the rows which has the string from the inputbox to be cut paste to sheet2. Here's the code I have so far.

Sub test2()
Dim btext As String
btext = InputBox("Insert in a text", "This accepts any input")

  For i = Cells(Rows.Count, 3).End(xlUp).Row To 6 Step -1
    With Cells(i, 3)
        If Not IsEmpty(.Value) Then
            If InStr(.Value, btext) = 0 Then _
                Rows(i).EntireRow.Cut Destination:=Sheets("Sheet2")
                'Range("D65536").End(xlUp).Offset(1, -3)
            End If
    End With
  Next i

End Sub

Not sure where you want to paste in Sheet2, but here are two examples. The first inserts into Sheet2 at the same row that it is found in the activesheet and shifts all other rows down. The second cuts and pastes just below the last non-blank row found in column C.

Sub test2a()
    Dim btext As String
    btext = InputBox("Insert in a text", "This accepts any input")
    For i = Cells(Rows.Count, 3).End(xlUp).Row To 6 Step -1
        With Cells(i, 3)
            If Not IsEmpty(.Value) Then
                If InStr(.Value, btext) <> 0 Then
                    Rows(i).EntireRow.Cut
                    Sheets("Sheet2").Cells(i, 1).Insert shift:=xlDown
                End If
            End If
        End With
    Next i
End Sub

Sub test2b()
    Dim btext As String
    Dim lnLastRow As Long
    btext = InputBox("Insert in a text", "This accepts any input")
    For i = Cells(Rows.Count, 3).End(xlUp).Row To 6 Step -1
        With Cells(i, 3)
            If Not IsEmpty(.Value) Then
                If InStr(.Value, btext) <> 0 Then
                    With Sheets("Sheet2")
                        lnLastRow = .Range("C" & Rows.Count).End(xlUp).Row
                        Rows(i).EntireRow.Cut Destination:=.Cells(lnLastRow + 1, 1)
                    End With
                End If
            End If
        End With
    Next i
End Sub

It's doing the cut and paste fine but I still need the blank rows to be deleted.

Thanks for the code.

Just add the line below after the row has been moved/paste:

Rows(i).EntireRow.Delete shift:=xlUp