Incrémenter les choix d'une multilist par ligne et non dans la même cellule

Bonjour,

J'applique dans un de mes tableaux des listes imbriquées qui amènent à une liste à choix multiples (merci m.Garbe).

j'ai besoin pour la suite, que les choix cochés se placent dans des lignes séparées plutôt que dans la même cellule (ici avec stemp - exemple 1).
Donc choix 1 coché en (exemple) (10,7) et choix 2 en (11,7) 11 étant une nouvelle ligne insérée (exemple 2, que j'ai évidemment bidouillé pour l'exemple )
Une idée?

merci

exemple 1:

exemple 2:

Private Sub type_danger_LB_Change()

If btest Then
Exit Sub
End If
    stemp = ""
    For i = 0 To Me.type_danger_LB.ListCount - 1
        If Me.type_danger_LB.Selected(i) Then
            stemp = stemp & Chr(10) & Me.type_danger_LB.List(i) & " - " & Chr(10) & Chr(10)

    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 = 7 Then
        If Cells(ActiveCell.Row, 6) = "" Then
            Me.type_danger_LB.Visible = False
            Exit Sub
            End If
            With Me.type_danger_LB
                .MultiSelect = fmMultiSelectMulti
                .ListStyle = fmListStyleOption
                .Height = 350
                .Width = 550
                .FontSize = 12
                .Top = ActiveCell.Top
                .Left = ActiveCell.Offset(0, 1).Left
                .Visible = True

            End With

            On Error Resume Next

            i = Application.WorksheetFunction.Match(Cells(ActiveCell.Row, 6), Worksheets("Liste").Range("source"), 0) - 1
            Me.type_danger_LB.List = Worksheets("Liste").Range(Worksheets("Liste").Range("A1").Offset(1, i), _
                Worksheets("Liste").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.type_danger_LB.ListCount - 1
                    If Not IsError(Application.Match(Me.type_danger_LB.List(i), a, 0)) Then
                        btest = True

                        Me.type_danger_LB.Selected(i) = True

                        btest = False
            End If
            Next

            End If
    Else
        Me.type_danger_LB.Visible = False

    End If

End Sub

Bonjour,

Essayer d'interpréter des lignes de code ne permet pas toujours de se représenter la structure du fichier, alors il serait souhaitable de disposer de ce fichier(sans données confidentielles) pour espérer obtenir des réponses.

Cdlt