仅在匹配条件时剪切并粘贴整行

Question

以下是我的代码，如果它与Yet_another_array数组中的值匹配，则会将一行切换到排除表上，但是它会剪切并粘贴工作表Main上的所有行，理想情况下只有29行（Yet_another_array数组中的29个UID）应该被剪切并附加到排除表格中。

     ReDim aCheck(1 To LR, 1 To LC)
                            Dim ASR As Worksheet, LS As Worksheet

                            Set ASR = ActiveWorkbook.Sheets("Main")
                            Set LS = ActiveWorkbook.Sheets("Exclusions")


            For i = 2 To LR
                    aCheck_Row = aCheck_Row + 1
                        aCheck(aCheck_Row, 1) = cells(i, cA)      'Security 'previously was fund #

                        Do
                            If IsError(Application.Match(aCheck(aCheck_Row, 1), Yet_Another_array, 1)) Then
                            'MsgBox "Found"

                            'If cells(i, 3) = Yet_Another_array(Yet_Another_array_Row, 1) Then
                            If IsError(Application.Match(cells(i, 3), Yet_Another_array, 0)) Then

                             ASR.cells(i, "C").EntireRow.Cut Destination:=LS.Range("A" & LS.Rows.Count).End(xlUp).Offset(1)
                                End If
                            End If

                            Exit Do

                        Loop While Not IsEmpty(aCheck)

            Next i