Hi, I'm not trained in VB so may be missing something but this seems tider
because it doesn't change the user's selection and has less lines. Also it
checks for top row.

Sub MoveDown()

Range(ActiveCell.Row + 1 & ":" & ActiveCell.Row + 1).Cut 'Cut row below
ActiveCell.EntireRow.Insert Shift:=xlDown 'Paste
ActiveCell.Offset(1, 0).Select 'Move down to it

End Sub


Sub MoveUp()

If ActiveCell.Row 1 Then
Range(ActiveCell.Row & ":" & ActiveCell.Row).Cut 'Cut active row
ActiveCell.Offset(-1, 0).Select 'Move up a row
ActiveCell.EntireRow.Insert Shift:=xlDown 'Paste
End If

End Sub