Microsoft 365 Extraction de résultats selon une condition

Function Magasins(CP$) As String
  Application.Volatile
  Dim cel As Range, mg$, ca#, tot#, n%, lig&, dcol%, chn$, s$, i%
  With Worksheets("CA")
    Set cel = .Columns(1).Find(CP, , -4163, 1, 1)
    If cel Is Nothing Then Exit Function
    dcol = .Cells(1, Columns.Count).End(1).Column
    If dcol < 3 Then Exit Function
    lig = cel.Row
    For i = 2 To dcol - 1
      mg = .Cells(1, i)
      If mg <> "" Then
        With .Cells(lig, i)
          ca = Round(.Value, 2)
          If ca > 0 And mg <> "(vide)" Then
            s = Format(ca, "#,##0.00")
            chn = chn & mg & " :" & Space$(18 - Len(s)) & s & vbLf
            tot = tot + ca: n = n + 1
          End If
        End With
      End If
    Next i
  End With
  If n > 0 Then chn = chn & vbLf & n & _
    " magasins :    " & Format(tot, "#,##0.00")
  Magasins = chn
End Function

Function Magasins(CP$) As String
  Application.Volatile
  Dim cel As Range, mg$, ca#, tot#, n%, lig&, dcol%, chn$, s$, i%
  With Worksheets("CA")
    Set cel = .Columns(1).Find(CP, , -4163, 1, 1)
    If cel Is Nothing Then Exit Function
    dcol = .Cells(1, Columns.Count).End(1).Column
    If dcol < 3 Then Exit Function
    lig = cel.Row
    For i = 2 To dcol - 1
      mg = .Cells(1, i)
      If mg <> "" Then
        With .Cells(lig, i)
          ca = Round(.Value, 0)
          If ca > 0 And mg <> "(vide)" Then
            s = Format(ca, "#,##0")
            chn = chn & mg & " :" & Space$(18 - Len(s)) & s & vbLf
            tot = tot + ca: n = n + 1
          End If
        End With
      End If
    Next i
  End With
  If n > 0 Then chn = chn & vbLf & n & _
    " magasins :    " & Format(tot, "#,##0")
  Magasins = chn
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lig As Variant, P As Range, Q As Range, R As Range
[B:B].Validation.Delete
With Sheets("Liste")
    .[1:3].Delete 'RAZ
    If Intersect(ActiveCell, [B:B]) Is Nothing Then Exit Sub
    On Error Resume Next
    With Sheets("CA")
        lig = Application.Match(ActiveCell(1, 0), .Columns(1), 0)
        Set P = .Rows(1).SpecialCells(xlCellTypeConstants, 1)
        Set Q = .Rows(lig).SpecialCells(xlCellTypeConstants, 1)
    End With
    Set R = Union(Intersect(P, Q.EntireColumn), Intersect(Q, P.EntireColumn))
    If R Is Nothing Then Exit Sub
    R.Copy .[A1]
    With .[A1].CurrentRegion.Rows(3)
        .FormulaR1C1 = "=R[-2]C&"" - ""&R[-1]C"
        .Name = "Liste" 'plage nommée
    End With
    ActiveCell.Validation.Add xlValidateList, Formula1:="=Liste" 'crée la liste
End With
End Sub