Choix multilple

Option Explicit
Private Sub CommandButton1_Click()
   Dim f2, ligne, i
   Set f2 = Sheets("bd")
   ligne = f2.[A65000].End(xlUp).Row + 1
   For i = 0 To Me.ListBox1.ListCount - 1
     If Me.ListBox1.Selected(i) = True Then
        f2.Cells(ligne, 1) = Me.ListBox1.List(i)
        f2.Cells(ligne, 2) = Me.ListBox1.List(i, 1)
        ligne = ligne + 1
     End If
  Next i
  Unload Me
End Sub

Private Sub UserForm_Initialize()
  Dim f
  Set f = Sheets("feuil1")
  ListBox1.List = f.Range("c2:d" & f.[A65000].End(xlUp).Row).Value
End Sub