Find And Move VBA Macro

find and move VBA macro - funky when WhatToFind in more than one row

Making a program that will find a value input by the user, and move the row of the cell that value is found in to the top of the list.

Works perfectly if there is only one row containing the search string. If more than one row contains the search string, it moves things to odd places.

here's the

Sub FindAndMoveToTop()
Dim FirstCell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
'Window prompt allowing user to define WhatToFind
WhatToFind = Application.InputBox("What are you looking for?", "Search", , 100, 100, , , 2)
'If WhatToFind is a value and not blank, move on
If WhatToFind <> "" And Not WhatToFind = False Then
'Start with first worksheet
Worksheets("Sheet1").Activate
'Start at first cell
Range("A1").Select
'Find the first cell containing WhatToFind (specified by user)
Set FirstCell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'If FirstCell exists, move on
If Not FirstCell Is Nothing Then
'Ok, First Cell is set
FirstCell.Activate
'Keep going...