Using active cell move entire row from one table to another

[rorobear]

Hello Everyone,

Hoping someone can please assist with the below code. I have two tables on a sheet (Table1 and Table2). When a button on the sheet (called “Move Above”) is clicked, the entire row based on the active cell is supposed to move up the last row of the Table1 from Table2. The problem is the correct row where the active cell is not being moved. Instead, the row above the active cell it is moved. Please help me correct this, any assistance is greatly appreciated. The workbook is attached.

 Option Explicit
 
Sub Move_AboveCutline()
' Macro to move the selected row from the Table to Table_1
    Dim Tbl As ListObject
    Dim NewRow As ListRow
   
    Set Tbl = Range("Table1").ListObject
    Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
   
    If Not Intersect(ActiveCell, ActiveSheet.ListObjects("Table2").DataBodyRange) Is Nothing Then
        Intersect(ActiveCell.EntireRow, Sheet1.ListObjects("Table2").DataBodyRange).Select
    Else
        MsgBox "You have not selected a row to move", vbInformation, "Move Row"
        Exit Sub
    End If
 
    Selection.Cut
   
    NewRow.Range = Selection.Value
   
    'Delete the active cell's entire row
    ActiveCell.EntireRow.Delete
   
    Application.CutCopyMode = False
   
End Sub