Insérer le contenu d'une ListBox dans cellules

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

Ladite fiche où sont transférer les valeurs de mon UsF :

fiche forum

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

Je ne transmets pas mon fichier contenant des données sensibles mais s'il le faut vraiment, je le modifie pour le joindre

Bonjour

Si tu ne joins pas ton fichier, il sera difficile de t'aider, au moins pour ce qui me concerne.

Bye !

Le voici

61bdl-forum.xlsm (97.97 Ko)

En cherchant/fouillant un peu, j'ai ma solution :

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

Je la poste, si cela peut aider ultérieurement

Rechercher des sujets similaires à "inserer contenu listbox"