Transfert valeurs listbox vers cellule, sous conditions

**Mél3790** · 21/11/2019, 11h45

Bonjour Le Forum,

J'utilise cette macro pour transférer les lignes sélectionnées de ma ListBox MultiSelect (LbPersonnel) vers ma feuille :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Dim element_select As Boolean
Dim nb_element, i As Integer
Dim DEST As Range
 
    element_select = False
    nb_element = LbPersonnel.ListCount
        With Worksheets("Formations")
            For i = 0 To nb_element - 1
                If LbPersonnel.Selected(i) = True Then
                    'MsgBox "Bien selectionné"
                    element_select = True
                    Set DEST = IIf(.Range("A1").Value = "", .Range("A2000"), .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                    DEST.Offset(0, 0) = "Planifier"
                    DEST.Offset(0, 1) = LbPersonnel.List(i, 0)
                    DEST.Offset(0, 2) = LbPersonnel.List(i, 1)
                    DEST.Offset(0, 3) = LbPersonnel.List(i, 2)
                    DEST.Offset(0, 4) = CbFormation.Value
                    DEST.Offset(0, 5) = TbFormationNTS.Value
                    DEST.Offset(0, 6) = CDate(CbDébut.Value)
                    DEST.Offset(0, 7) = CDate(CbFin.Value)
                    DEST.Offset(0, 8) = TbSemaine.Value
                    DEST.Offset(0, 9) = TbJours.Value
                    DEST.Offset(0, 10) = TbHeures.Value
                    DEST.Offset(0, 11) = CbType.Value
                    DEST.Offset(0, 12) = TbInEx.Value
                    DEST.Offset(0, 13) = CbOrganisme.Value
                    DEST.Offset(0, 14) = CbLieu.Value
                    DEST.Offset(0, 17) = TbCoutF°.Value        
                 End If
            Next
         End With

Donc si j'ai sélectionné 3 lignes dans ma LB par exemple, 3 lignes de ma feuille vont se remplir.

Ce que je souhaiterais, c'est que ça : DEST.Offset(0, 17) = TbCoutF°.Value ne soit inscrit que sur la première ligne de ma feuille et pas les 2 autres.
Est-ce que c'est possible ?

Merci beaucoup d'avance pour votre aide et de vous penchez sur mon cas

**ARTURO83** · 22/11/2019, 07h50

Bonjour,

Essayez ceci (pas testé)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    'Recherche de la première ligne vide dans la colonne A
    NwLig = Range("A" & Rows.Count).End(xlUp).Row + 1
    With Worksheets("Formations")
        Cells(NwLig, 17) = TbCoutF°.Value
        For i = 0 To nb_element - 1
            If LbPersonnel.Selected(i) = True Then
                'MsgBox "Bien selectionné"
                element_select = True
                Range(Cells(NwLig, 1), Cells(NwLig, 15)) = Array("Planifier", LbPersonnel.List(i, 0), LbPersonnel.List(i, 1), LbPersonnel.List(i, 2), CbFormation.Value, _
                TbFormationNTS.Value, CDate(CbDébut.Value), CDate(CbFin.Value), TbSemaine.Value, TbJours.Value, TbHeures.Value, CbType.Value, TbInEx.Value, CbOrganisme.Value, CbLieu.Value)
                NwLig = NwLig + 1
             End If
        Next
     End With

Cdlt