XL 2019 occurrence de textes dans une colonne

Option Compare Text
Sub Bouton1_Cliquer()
Dim Plage As Range

Col = ActiveCell.Column
Ligne_Debut = ActiveCell.Row
Ligne_Fin = Cells(Rows.Count, Col).End(xlUp).Row

    'Set Plage = Application.InputBox(Prompt:="Selectionner le Plage de valeur", Type:=8)
    Set Plage = Range(Cells(Ligne_Debut, Col), Cells(Ligne_Fin, Col))
    
    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = vbTextCompare
    For Each Cell In Plage.Cells
        Select Case True
            Case Cell = ""
            Case Dict.exists(Cell.Value): Dict(Cell.Value) = Dict(Cell.Value) + 1
            Case Else:                    Dict(Cell.Value) = 1
        End Select
    Next
    
    DicoTriKeysVal Dict, 1 '1: tri des clés 2: tri des valeurs
    memo_texte = ""
    For Each D In Dict
        memo_texte = memo_texte & D & ":   " & Dict(D) & vbLf
    Next
    MsgBox (memo_texte)
    
End Sub
' http://boisgontierj.free.fr/pages_site/Dictionnaire.htm
Sub Tri(a, gauc, droi, colTri)         ' Quick sort
 ref = a((gauc + droi) \ 2, colTri)
 g = gauc: D = droi
 Do
     Do While a(g, colTri) < ref: g = g + 1: Loop
     Do While ref < a(D, colTri): D = D - 1: Loop
     If g <= D Then
       temp = a(g, 1): a(g, 1) = a(D, 1): a(D, 1) = temp
       temp = a(g, 2): a(g, 2) = a(D, 2): a(D, 2) = temp
       g = g + 1: D = D - 1
     End If
 Loop While g <= D
 If g < droi Then Call Tri(a, g, droi, colTri)
 If gauc < D Then Call Tri(a, gauc, D, colTri)
End Sub
' http://boisgontierj.free.fr/pages_site/Dictionnaire.htm
Sub DicoTriKeysVal(dico, colTri)
  Dim Tbl(): ReDim Tbl(1 To dico.Count, 1 To 2)
  i = 0
  For Each c In dico.keys
    i = i + 1
    Tbl(i, 1) = c: Tbl(i, 2) = dico(c)
  Next c
  Tri Tbl, LBound(Tbl), UBound(Tbl), colTri
  dico.RemoveAll
  For i = LBound(Tbl) To UBound(Tbl)
    dico(Tbl(i, 1)) = Tbl(i, 2)
  Next i
End Sub