Copy rows based on cell value

Option ExplicitSub Macro1()




    Dim lngMyRow    As Long
    Dim lngLastRow  As Long
    Dim lngPasteRow As Long
    Dim wsSource    As Worksheet
    Dim wsOutput    As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSource = Sheets("2017")
    Set wsOutput = Sheets("Errors")
    
    'Clear any existing entires on 'wsOutput' tab
    On Error Resume Next 'Account for there being no data on the tab
        lngLastRow = wsOutput.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If lngLastRow >= 7 Then
            wsOutput.Rows("7:" & lngLastRow).ClearContents
        End If
    On Error GoTo 0
    
    'Move applicable rows from 'wsSource' tab to 'wsOutput' tab.
    On Error Resume Next 'Account for there being no data on the tab
        lngLastRow = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If lngLastRow >= 7 Then
            For lngMyRow = 7 To lngLastRow
                If StrConv(wsSource.Range("BP" & lngMyRow), vbProperCase) = "No" Then
                    If lngPasteRow = 0 Then
                        lngPasteRow = 7
                    Else
                        lngPasteRow = lngPasteRow + 1
                    End If
                    wsOutput.Range("A" & lngPasteRow).Value = wsSource.Range("BS" & lngMyRow)
                    wsOutput.Range("B" & lngPasteRow).Value = wsSource.Range("A" & lngMyRow)
                    wsOutput.Range("C" & lngPasteRow).Value = wsSource.Range("B" & lngMyRow)
                    wsOutput.Range("D" & lngPasteRow).Value = wsSource.Range("C" & lngMyRow)
                    wsOutput.Range("E" & lngPasteRow).Value = wsSource.Range("D" & lngMyRow)
                End If
            Next lngMyRow
        End If
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    
    MsgBox "Done", vbInformation




End Sub