copy and paste filter values based on array criteria getting error "NO CELLS FOUND"

[srikanth sare]

The below code is copying filter values based on array criteria.

It works fine until when filter value doesnot exit in array getting error "NO CELLS FOUND"

help me in solving error and also any improvement in code

Sub PLOT()
    On Error GoTo EH
    Application.Run "TurnOff"
    Sheet8.AutoFilterMode = False
    Sheet5.Unprotect "1818"
    Sheet5.Cells.Copy
    Sheet8.Range("A1").PasteSpecial xlPasteValues
    Sheet8.Range("A1").PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    Sheet9.Range("A6:EB9999").Clear

    Sheet9.Range("ED6:FG" & Range("FG9999").Row).ClearContents
    Dim lst, PasteCol1, PasteCol2, Cell As Long, FilterArray, FilterCol As Variant
    PasteCol1 = 134
    PasteCol2 = 135
    FilterArray = Array("UPD", "DF 1", "DF 2", "DF 3", "ALL", "N-ALL", "E", "U-REG", "REG", "A-RF", "RF", "A-TF", "I-TF", "E-TF", "CL", "DUM") ' FilterArray should be in order from the last value to be removed to the first value to be removed
    lst = Sheet8.Range("A6").CurrentRegion.Rows.Count
    For Each FilterCol In FilterArray
    Sheet8.Rows("5:5").AutoFilter Field:=2, Criteria1:=FilterCol, Operator:=xlFilterValues
    Sheet8.Range("C6:C" & lst).SpecialCells(xlCellTypeVisible).Copy
    Sheet9.Cells(6, PasteCol1).PasteSpecial xlPasteValues
    Sheet8.Range("M6:M" & lst).SpecialCells(xlCellTypeVisible).Copy
    Sheet9.Cells(6, PasteCol2).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    PasteCol1 = PasteCol1 + 2
    PasteCol2 = PasteCol2 + 2
    Next FilterCol
    
CleanUp:         On Error Resume Next
         Application.Run "TurnOn"
         Sheet8.Cells.Clear
   Sheet5.Protect "1818", DrawingObjects:=False, Contents:=True, Scenarios:=False, UserInterFaceOnly:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True
   Exit Sub
EH: Debug.Print Err.Description  ' Do error handling
   MsgBox "Sorry, an error occured." & vbCrLf & Err.Description, vbCritical, "Error!"
   Resume CleanUp

End Sub