Trier avec des cellules contenant des formules et des des liaisons.

Sub Filtrer_Data()
Dim R As Range
    Set sh = ActiveWorkbook.Worksheets("MENU LILIANE")
    Set R = sh.Columns("b").Find("Produits", , xlValues, xlWhole, xlByRows, xlNext)
    Do While Not R Is Nothing
        If sr = "" Then sr = R.Address
        Rng = R.Offset(1).Address
        Set R = sh.Columns("b").Find("Produits", R, xlValues, xlWhole, xlByRows, xlNext)
        sh.Sort.SortFields.Clear
        sh.Sort.SortFields.Add Key:=sh.Range(Rng), Order:=xlDescending, SortOn:=xlSortOnValues
        sh.Sort.SortFields.Add Key:=sh.Range(Rng).Offset(0, 2), Order:=xlDescending, SortOn:=xlSortOnValues
        If R.Address = sr Then
            Set Plage = sh.Range(Rng & ":D" & sh.UsedRange.Rows.Count)
        Else
            Set Plage = sh.Range(Rng & ":D" & R.Row - 2)
        End If
        sh.Sort.SetRange Plage
        sh.Sort.Apply
        sh.Sort.SortFields.Clear
        sh.Sort.SortFields.Add Key:=sh.Range(Rng), Order:=xlAscending
        sh.Sort.SortFields.Add Key:=sh.Range(Rng).Offset(0, 2), Order:=xlAscending, SortOn:=xlSortOnValues
        If R.Address = sr Then
            Set S = sh.Range(Rng & ":b" & sh.UsedRange.Rows.Count).Find("")
        Else
            Set S = sh.Range(Rng & ":b" & R.Row - 2).Find("")
        End If
        sh.Sort.SetRange sh.Range(Rng & ":D" & S.Row - 1)
        sh.Sort.Apply
        If R.Address = sr Then Set R = Nothing
    Loop
End Sub

Const NbJours = 5
Const NbMenus = NbJours * 2
Const NbLignesMenu = 42
Const PremièreLigneMenu = 3
Const NbColonnesMenu = 3
Const PremièreColonneMenu = 2

Sub trierMenu()
Dim derlig&, t, i&, i1&, i2&, j&

Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
derlig = Cells(Rows.Count, "b").End(xlUp).Row: t = Range("b1:b" & derlig)
i2 = UBound(t)
Do
   For i = i2 To 1 Step -1
      If t(i, 1) <> "" Then Exit For
   Next i
   If i = 0 Then Exit Do
   For j = i - 1 To 1 Step -1
      If t(j, 1) = "PRODUITS" Then Exit For
   Next j
   If j = 0 Then Exit Do
   Range(Cells(j, 2), Cells(i, 4)).Sort key1:=Cells(j, 2), order1:=xlAscending, MatchCase:=False, Header:=xlYes
   i2 = j - 2: If i2 <= 1 Then Exit Sub
Loop
End Sub

Sub Filtrer_Data()
Dim R As Range, Sh As Range, Plage As Range
Dim Sr As String

    Set Sh = ActiveWorkbook.Worksheets("MENU LILIANE")
    Set R = Sh.Columns("b").Find("Produits", , xlValues, xlWhole, xlByRows, xlNext)
    Do While Not R Is Nothing
        If Sr = "" Then Sr = R.Address
        Rng = R.Offset(1).Address
        Set R = Sh.Columns("b").Find("Produits", R, xlValues, xlWhole, xlByRows, xlNext)
        Set Plage = Sh.Range(Rng & ":D" & IIf(R.Address = Sr, Sh.UsedRange.Rows.Count, R.Row - 2))
        Sh.Sort.SortFields.Clear
        Plage.Sort Header:=xlNo, Key1:=Plage.Columns(1), Order1:=xlAscending, key2:=Plage.Columns(3), order2:=xlAscending, MatchCase:=False
        If R.Address = Sr Then Set R = Nothing
    Loop

End Sub