XL 2016 Insérer le contenu d'une ListBox dans cellules

[Yoyo01000]

Bonjour le forum,

Je bloque sur un transfert d'un contenu d'une ListBox vers des cellules.

J'ai un UsF qui génère un fiche dans un onglet nommé par ce même UsF.

Sur cette fiche, les infos sont collectées depuis mon formulaire.

Tout fonctionne sauf le transfert du contenu d'une ListBox pouvant contenir 3 ou 4 noms.

Ce contenu de ListBox doit pouvoir s'intégrer à partir de la cellule B11 jusqu'à B13 ou B14.

Voici mon UsF (ListBox concernée par le cadre noir) :

UsF Forum.jpg (155.43 Kio) Vu 5 fois
Ladite fiche où sont transférer les valeurs de mon UsF :

Fiche forum.jpg (62.61 Kio) Vu 5 fois
Et pour finir, le code qui me pose problème :

With List_Noms
Range(Cells(11, 2), ActiveCell(.ListCount, 1)) = .List
End With

Intégrer dans ce code rattaché au CommandButton :

Private Sub CommandButton3_Click()

'Cherche et trouve des champs non remplis/ComboBox/TextBox/...
Dim CTRL As Control 'déclare la variable CTRL (ConTRôLe)
For Each CTRL In Me.Controls 'boucle sur touts les contrôles de l'UserForm en cours
'condition 1 : si le contrôle est une Combobox ou une TextBox (et autres) :
If TypeOf CTRL Is MSForms.ComboBox Or TypeOf CTRL Is MSForms.TextBox Then
If CTRL.Value = "" Then 'condition 2 : si le contrôle est vide = Message avec avertissement
MsgBox "Champ non renseigné !", vbExclamation
CTRL.SetFocus 'place le curseur dans le controle
Exit Sub 'sort de la procédure
End If 'fin de la condition 2
End If 'fin de la condition 1
Next CTRL 'prochain contrôle de la boucle

If List_Noms.ListCount <> TextBox2.Value Then
MsgBox "Aucun effectif sélectionné !", vbExclamation
List_Noms.BackColor = vbRed
Exit Sub
End If

'****************************************
'CommandButton3.BackColor = vbGreen
'***************************************

Dim feuille As String
feuille = Me.ComboBox1.Text & " " & Me.ComboBox2.Text & " " & Me.ComboBox4.Text & " " & Me.ComboBox5.Text
' on met en marche la gestion des erreurs
On Error Resume Next
' on active la feuille du nom de Feuille
Sheets(feuille).Activate
If Err > 1 Then ' la feuille n'existe pas on la crée
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.name = feuille
Else ' elle existe
' on la supprime
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
' on en crée une nouvelle qui porte le nom choisi
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.name = feuille
End If
' on arrête la gestion des erreurs
On Error GoTo 0

'Permet de lister tous les onglets dans une ListBox :
Dim WS As Worksheet
ListBox1.Clear
For Each WS In Worksheets
If WS.Visible = xlSheetVisible Then
ListBox1.AddItem WS.name
End If
Next WS

List_Noms.BackColor = vbWhite





'Insertion d'une feuille avec tableau
With Sheets("VIERGE").Select
Range("B2").Select
Selection.CurrentRegion.Select
Selection.Copy
'Sélection du dernier onglet à droite :
Sheets(Sheets.Count).Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
ActiveWindow.Zoom = 70
Range("B2").Select
End With

Range("B3").Value = ComboBox1.Value & " " & ComboBox2.Text & " " & TextBox1.Value
Range("B5").Value = ComboBox4.Text
Range("B7").Value = ComboBox5.Text
Range("B9").Value = TextBox2.Value
'Range("B11").Value = List_Noms
With List_Noms
Range(Cells(11, 2), ActiveCell(.ListCount, 1)) = .List
End With

'Vider les ComboBox & les ListBox & les TextBox :
ComboBox1.Clear
ComboBox2.Clear
ComboBox4.Clear
ComboBox5.Clear
TextBox2.Value = ""
TextBox2.BackColor = vbWhite
List_Noms.Clear
List_Effectif.Clear

Call userform_initialize

End Sub

Fichier en PJ, si besoin

 

[Robert]

Bonjour Yoyo, bonjour le forum,

Essaie avec :

With List_Noms
    For I = 0 To .ListCount - 1
        Cells(11 + I, 2).Value = .List(I, 0)
    Next I
End With

 

[Yoyo01000]

Bonjour Robert,

En un mot : PARFAIT !

Merci beaucoup pour ton aide