Tri d'un tableau avec une liste déroulante

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F2")) Is Nothing Then
        InputDP
    End If
End Sub

Option Explicit

Sub InputDP()
    Dim DlignDP, DlignDT, Debut, Fin, AppCalcInitial
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    AppCalcInitial = Application.Calculation
    'neutralisation des calculs au cas où les tris auraient une incidence sur le résultat des formules + gain de temps
    Application.Calculation = xlCalculationManual
    
    'initialisation
    DlignDP = Sheets("Dashboard_Priorities").Cells(Rows.Count, 4).End(xlUp).Row
    DlignDT = Sheets("Database_Task").Cells(Rows.Count, 3).End(xlUp).Row
    Sheets("Dashboard_Priorities").Range("C6:M" & DlignDP + 1).Clear '+1 au cas où DlignDP = 5
    Select Case Sheets("Dashboard_Priorities").Range("F2")
    Case "Within 2 days"
        Debut = 0
        Fin = 3
    Case "Within 7 days"
        Debut = 2
        Fin = 8
    Case "Within 15 days"
        Debut = 8
        Fin = 16
    End Select
    
    Sheets("Database_Task").Activate
    With Sheets("Database_Task")
        On Error Resume Next
        .ShowAllData ' au cas où Database aurait un filtre déjà actif
        .Range("B5:U" & DlignDT).Sort Key1:=.Range("T5"), Order1:=xlDescending, _
                                Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
                                Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        Selection.AutoFilter Field:=13, Criteria1:=">=" & Debut, _
                                Operator:=xlAnd, Criteria2:="<" & Fin
        On Error Resume Next 'évite de planter si aucune ligne visible
        .Range("B5:L" & DlignDT).SpecialCells(xlCellTypeVisible).Copy _
                                Destination:=Sheets("Dashboard_Priorities").Range("C6")
        'Remise en forme de Database
        .ShowAllData
        .Range("B5:U" & DlignDT).Sort Key1:=.Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
                       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                       DataOption1:=xlSortNormal
    End With
    
    Sheets("Dashboard_Priorities").Activate
    Application.Calculation = AppCalcInitial
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub