Move entire row from one sheet to another based on cell value & delete the original row

[ceciliacrawford]

Move entire row from one sheet to another based on cell value.
I am trying to setup my spreadsheet so that when a row’s status in one sheet (Dashboard) is changed to “Closed,” the entire row is copied, deleted and then placed in another sheet (Completed).

Everything is working except for the “deleting” the original cell in the Dashboard sheet.

I hope I explained in enough detail. Please look at my code and see what I am doing wrong! I also attached my excel spreadsheet.

Sub cuttosheet()
Dim sRng As Range, cell As Range
Dim dRng As Range
Set sRng = Sheets("Dashboard").Range([A1], [A65536].End(xlUp))
For Each cell In sRng
If cell.Value = "Closed" Then
Set dRng = Sheets("Completed").[A65536].End(xlUp)(2, 1)
cell.EntireRow.Cut dRng
End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A65536")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim NR As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "closed"
      Range("A" & Target.Row & ":Q" & Target.Row).Copy Worksheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      Target.EntireRow.Delete Shift:=xlUp
   End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

Sub MoveMe(rTarget As Range)
    Dim wsMoveTo    As Worksheet
    Dim rMoveToRow  As Range
    Dim rCopyFrom   As Range
    Dim rCopyTo     As Range
    Dim rItem       As Range
    Dim rMoveUp     As Range
    Dim bEvents     As Boolean
    Dim bScrUpd     As Boolean
    Dim lCalc       As Long
    
    With Application
        bEvents = .EnableEvents
        bScrUpd = False
        lCalc = .Calculation
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Select Case rTarget.Text
        Case "closed"
            Set wsMoveTo = Sheets(rCompleted)
        Case Else
            Exit Sub
    End Select
    Set rMoveToRow = wsMoveTo.Cells.Find("Potential", LookIn:=xlValues, LookAt:=xlWhole).End(xlUp).Offset(1)
    Set rCopyFrom = Range(Cells(rTarget.Row, "A"), Cells(rTarget.Row, "Q"))
    Set rCopyTo = wsMoveTo.Range(wsMoveTo.Cells(rMoveToRow.Row, "A"), wsMoveTo.Cells(rMoveToRow.Row, "Q"))
    rCopyTo.Formula = rCopyFrom.Formula
    Set rMoveUp = Range(Cells.Find("Potential", LookIn:=xlValues, _
        LookAt:=xlWhole).End(xlUp).Offset(1), rCopyFrom)
    rMoveUp.Formula = rMoveUp.Offset(1).Formula

    
    Set wsMoveTo = Nothing
    Set rMoveToRow = Nothing
    Set rCopyFrom = Nothing
    Set rCopyTo = Nothing
    
    With Application
        .EnableEvents = bEvents
        .ScreenUpdating = bScrUpd
        .Calculation = lCalc
    End With
End Sub

Thanks!!!