Sub FindAndMove()
Dim Reg As String
Dim rF As Range
Application.ScreenUpdating = False
Reg = InputBox("Type vehicle registration number.")
If Reg = "" Then Exit Sub
With Range("D:D")
Set rF = .Find(What:=Reg, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rF Is Nothing Then
rF.EntireRow.Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
rF.EntireRow.Delete
Else
MsgBox "The vehicle registration: " & Reg & " was not found!", vbExclamation
End If
End With
End Sub