Macro : 2 listes déroulante à choix multiple dans une feuille

Bonjour,

Je fais suite à ma demande d'avant hier concernant une liste déroulante.

Je devais créer une liste déroulante à choix multiple. Hors, maintenant on me demande de créer une deuxième liste déroulante à choix multiple.

Ci-après le code dans mon userform1 :
Option Explicit

Private Sub Validation()
Dim i As Byte
Dim ValeurARetourner As String
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
ValeurARetourner = ValeurARetourner & ListBox1.List(i) & " & "
End If
Next i
If ValeurARetourner = "" Then
MsgBox "Sélection obligatoire ou fermez avec la croix"
Exit Sub
End If
ActiveCell = Left(ValeurARetourner, Len(ValeurARetourner) - 3)
ActiveCell.Offset(1, 0).Activate
UserForm1.Hide
Unload UserForm1
End Sub

Private Sub CommandButton1_Click()
Call Validation

End Sub

Private Sub UserForm_Initialize()
Dim i As Integer, Derlig As Integer
ListBox1.Clear
With Sheets("ListedeChoix")
Derlig = .Cells(65536, 1).End(xlUp).Row
For i = 1 To Derlig
ListBox1.AddItem .Cells(i, 1).Value
Next i
End With
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
ListBox1.Selected(i) = False
End If
Next i

End Sub

Ci-après le code de l'userform2 (j'ai fais un copier/coller de l'userform1) :
Option Explicit

Private Sub Validation()
Dim i As Byte
Dim ValeurARetourner As String
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
ValeurARetourner = ValeurARetourner & ListBox1.List(i) & " & "
End If
Next i
If ValeurARetourner = "" Then
MsgBox "Sélection obligatoire ou fermez avec la croix"
Exit Sub
End If
ActiveCell = Left(ValeurARetourner, Len(ValeurARetourner) - 3)
ActiveCell.Offset(1, 0).Activate
UserForm1.Hide
Unload UserForm1
End Sub

Private Sub CommandButton1_Click()
Call Validation

End Sub

Private Sub UserForm_Initialize()
Dim i As Integer, Derlig As Integer
ListBox1.Clear
With Sheets("ListedeChoix")
Derlig = .Cells(65536, 3).End(xlUp).Row
For i = 1 To Derlig
ListBox1.AddItem .Cells(i, 3).Value
Next i
End With
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
ListBox1.Selected(i) = False
End If
Next i

End Sub

Ci-après le code dans ma feuille de destination : (et je pense que c'est la que je coince)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("Q:Q")) Is Nothing Then
Exit Sub
Else
Target.Value = ""
Load UserForm1
UserForm1.Show
End If
End Sub

Pouvez-vous m'aider SVP.

Merci