Macro filtre sur données, erreur si pas de donnée trouvée...

Sub FiltrePatiss()
    Range("_BDR").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("ZCpatiss" _
        ), CopyToRange:=Range("ZDpatiss"), Unique:=True
    Range("O3:O20").ClearContents
    Dim cel As Range, ref As Range
    If Range("M65536").End(xlUp).Row <> 2 Then
        For Each cel In Range("M3:M50").SpecialCells(xlCellTypeConstants, 2)
            Set ref = Range("O20").End(xlUp)(2)
            If Application.CountIf(Range("O3", ref), cel) = 0 Then ref = cel
        Next
        Range("O3", ref).Sort Key1:=Range("O3"), Order1:=xlAscending, Header:=xlNo
    End If
    Range("A3").Select
End Sub

Sub FiltrePatissMidi()
Dim n&
Range("U6:Y5000").ClearContents
Range("_BDR").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("ZCpatiss"), CopyToRange:=Range("ZDpatiss"), Unique:=True
n = Application.CountA(Range("V:V")) - 1
If n = 0 Then Exit Sub
Range("U6:X" & n + 5).Sort Key1:=Range("W6"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Sub FiltrePatissMidi()
Dim n&, rng As Range, c As Range, d
Range("U6:Y5000").ClearContents
Range("_BDR").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("ZCpatiss"), CopyToRange:=Range("ZDpatiss"), Unique:=True
n = Application.CountA(Range("V:V")) - 1
If n = 0 Then Exit Sub
Set rng = Range("U6:X" & n + 5)
rng.Sort Key1:=Range("W6"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set d = CreateObject("Scripting.Dictionary")
For Each c In rng.Columns(3).Cells
    If Not d.Exists(c.Value) Then d.Add c.Value, c.Value
Next
Range("Y6").Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub