Microsoft 365 liste à choix multiples avec contenu variable

Bonjour à tous,

Je suis débutant sur VBA, et je souhaiterai mettre sur pied un fichier avec une liste à choix multiples avec contenu variable.
Je me suis inspiré de plusieurs vidéos sur youtube, et malgré ça mon code ne fonctionne pas.
Je l'ai établi sur une feuille de calcul en utilisant le "Private Sub Worksheet_SelectionChange(ByVal Target As Range)".
Visiblement j'ai l'impression qu'il ne le lit pas, j'ai donc tout copié collé sur un module et il ne fonctionne toujours pas.

Quelqu'un pourrait m'aider à faire tourner mon code en dessous svp ?

Option Explicit
Dim i As Long
Dim stemp As String
Dim a
Dim btest As Boolean

Private Sub ListBox1_Change()
If btest Then
Exit Sub
End If

stemp = ""
For i = o To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
stemp = stemp & Me.ListBox1.List(i) & "-"
End If
Next
stemp = VBA.Left(stemp, VBA.Len(stemp) - 1)
ActiveCell = stemp
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 4 Then
If Cells(ActiveCell.Row, 2) = "" Then
Me.ListBox1.Visible = False
Exit Sub
End If
With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
.Height = 150
.Width = 100
.Top = ActiveCell.Top
.Left = ActiveCell.Offset(0, 1).Left
.Visible = True
End With
On Error Resume Next
i = Application.WorksheetFunction.Match(Cells(ActiveCell.Row, 2), Worksheets("Donnée").Range("Familles"), 0) - 1
Me.ListBox1.List = Worksheets("Donnée").Range(Worksheets("Donnée").Range("A1").Offset(1, i), _
Worksheets("Donnée").Range("A1").Offset(0, i).End(xlDown)).Value
On Error GoTo 0
a = VBA.Split(ActiveCell, "-")
If UBound(a) >= 0 Then
For i = 0 To Me.ListBox1.ListCount - 1
If Not IsError(Application.Match(Me.ListBox1.List(i), a, 0)) Then
btest = True
Me.ListBox1.Selected(i) = True
btest = False
End If
Next
End If
Else
Me.ListBox1.Visible = False
End If
End Sub

J'ai ajouté mon fichier juste en dessous.

Merci d'avance