VBA_Liste a choix multiples

help....

bjr

voici des codes a adapter

Private Sub CmdOK_Click()
Unload UserForm1
Dim Tblo()
Dim A As Integer
Dim B As Integer
Dim T As Integer

With Me.ListBox1
'Déterminer le nombre d'items choisis
For A = 0 To .ListCount - 1
If .Selected(A) Then
T = T + 1
End If
Next A

'Si aucun élément sélectionné , fin de la procédure
If T = 0 Then Exit Sub

'Dimensionnement du tableau
'Avec preserve on ne peut redimensionner que
'la dernière dimension d'un tableau
'de façon dynamique -> raison du décompte(partie1)

ReDim Preserve Tblo(1 To T)
'valeur sélectionnée mise dans le tableau
For A = 0 To .ListCount - 1
If .Selected(A) Then
B = B + 1
Tblo(B) = .List(A, 0)
'le 0 indique que l'item est dans la première colonne de la liste
'dans cet exemple il n'y a qu'une colonne
End If
Next A
End With
'Copie le tableau à partir de B16 = cells(16,2)
Range(Cells(16, 2), Cells(16 + UBound(Tblo) - 1, 2)) = Application.Transpose(Tblo)
' Attention aux index qui commencent à 0 et non pas à 1... !
' NB subtilité des array... : un tableau à une dimension s'inscrit sur
'une ligne... il faut donc utiliser transpose pour obtenir le résultat
'en colonne.

'Libère la mémoire
Erase Tblo

End Sub

Private Sub UserForm_Initialize()
Range("B16:B26").ClearContents 'efface la plage résultats
ListBox1.RowSource = "liste1!liste"
ListBox1.ListIndex = -1
End Sub