Sub MoveRows()
Dim iEndF As Integer
Dim iEndT As Integer
Dim iRow As Integer
Dim c As Range
Dim str1 As String
str1 = Application.InputBox("enter a search term", Type:=8)
iEndF = Sheets("Open").Cells(4, 4).End(xlDown).Row
iEndT = 1 + Sheets("Closed").Cells(4, 4).End(xlDown).Row
For iRow = iEndF To 5 Step -1
If Sheets("Open").Cells(iRow, 4) = str1 Then
Sheets("Open").Rows(iRow).Copy
Sheets("Closed").Cells(iEndT, 1).PasteSpecial (xlAll)
Sheets("Open").Cells(iRow, 4).EntireRow.Delete
iEndT = iEndT + 1
End If
Next iRow
End Sub