Archive rows from one worksheet to another, based on the value of a cell in each row

Sub ArchiveInvoces()
  With Worksheets("DRS REGISTER").ListObjects("Table1")
    .Range.AutoFilter Field:=11, Criteria1:="YES"
    On Error GoTo NoRows
    With .DataBodyRange.SpecialCells(xlCellTypeVisible)
      Worksheets("ARCHIVE").ListObjects("Table14").ListRows.Add
      .Copy Worksheets("ARCHIVE").ListObjects("Table14").ListColumns(1).Range(Worksheets("ARCHIVE").ListObjects("Table14").ListRows.Count + 1)
      .EntireRow.Delete
    End With
    .Range.AutoFilter Field:=11
  End With
NoRows:
End Sub

Sub CopyToArchive()
Dim sws As Worksheet, dws As Worksheet
Dim tbl As ListObject


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sws = Sheets("DRS REGISTER")
Set tbl = sws.ListObjects(1)
Set dws = Sheets("ARCHIVE")
sws.AutoFilterMode = False


With tbl.Range
    .AutoFilter field:=11, Criteria1:="YES"
    If tbl.Range.Columns(11).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
        dws.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    End If
    tbl.Range.AutoFilter field:=11
End With


Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub