XL 2016 Transfert de listbox sur feuille

[Scorpio]

Salut à tous,
J'aimerais juste s'il vous plais que un membre me donne un petit coup de pouce, concernant ce code
En fait, ce code fonctionne bien, mais transfert les données dès la cellule A1
Et, je voudrais laissé la première ligne vide et transférer dés la cellule A2.
Merci beaucoup A+++


Private Sub CommandButton1_Click()
'Call SupPlage
Sheets("Feuil3").[A2].Select
Dim x As Integer, Nb_L_ListBox As Integer
With Worksheets("feuil3")
For x = 1 To Me.ListBox1.ListCount
.Cells(x, 1) = Me.ListBox1.List(x - 1, 0) 'Colonne A
.Cells(x, 3) = Me.ListBox1.List(x - 1, 1) 'Colonne C
.Cells(x, 6) = Me.ListBox1.List(x - 1, 2) 'Colonne F
Next x
End With
End Sub

 

[job75]

Bonjour Scorpio,

Private Sub CommandButton1_Click()
Dim x As Integer
With Worksheets("feuil3")
    For x = 1 To ListBox1.ListCount
        .Cells(x + 1, 1) = ListBox1.List(x - 1, 0) 'Colonne A
        .Cells(x + 1, 3) = ListBox1.List(x - 1, 1) 'Colonne C
        .Cells(x + 1, 6) = ListBox1.List(x - 1, 2) 'Colonne F
    Next x
End With
End Sub

A+

 

[Scorpio]

Bonsoir Job75,
Merci beaucoup du coup de pouce,
Juste une question, ces lignes de code ci-dessous reste identique, peux importe la colonne choisie pour le transfert ?
.Cells(x + 1, 1) = ListBox1.List(x - 1, 0) 'Colonne A
.Cells(x + 1, 3) = ListBox1.List(x - 1, 1) 'Colonne C
.Cells(x + 1, 6) = ListBox1.List(x - 1, 2) 'Colonne F

 

[job75]

Re,

Pas compris la question mais vous n'avez qu"à tester.

A+

 

[Scorpio]

RE,
OK, merci beaucoup Job75
A+++

 

[BOISGONTIER]

Bonsoir,

Plus rapide en exécution:

  Application.ScreenUpdating = False
  Set f = Sheets("Feuil3")
  n = ListBox1.ListCount
  Tbl = Me.ListBox1.List
  f.[A2].Resize(n) = Application.Index(Tbl, , 1)
  f.[C2].Resize(n) = Application.Index(Tbl, , 2)
  f.[F2].Resize(n) = Application.Index(Tbl, , 3)

Boisgontier

 

[Scorpio]

Bonsoir,
OK, je vais essayer tous ça.
Merci beaucoup Boisgontier pour votre aide. A+++

 

[Scorpio]

RE,
Dite Boisgontier, s'il vous plaît, ou je pourrais trouver le code complet, car vraiment je ne suis pas un as du code.

 

[BOISGONTIER]

>Dite Boisgontier, s'il vous plaît, ou je pourrais trouver le code complet, car vraiment je ne suis pas un as du code.

Sans le fichier, ça me parait difficile.

Boisgontier

 

[ChTi160]

Bonjour Scorpio
Bonjour le Fil ,le Forum
Peut être en faisant après avoir ouvert le Fichier de JB (que je salue) Alt+F11
et tu accèdes au Code du Fichier .
jean marie

 

[Scorpio]

Salut Chti160,
Ha, avec l'âge, c'est pas si facile.
Merci du conseil
A+++

 

[Scorpio]

Bonjour Mr BOISGONTIER
Excusé du retard, et en plus, je n'ai pas remarqué le fichier que vous avez joint , Ha c'est dure tous de même.
Merci encore de votre aide. C'est un bon coup de pouce que vous me donné, merci.
Je cherche encore une chose, c'est d'y ajouter un Combobox pour filtrer les données de la colonne "A", et ensuite de transférer dans la feuille Result.
A+++, et merci

 

[BOISGONTIER]

Bonjour,

Dim f, TblBD()
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  Set Rng = f.Range("A2:F" & f.[A65000].End(xlUp).Row)
  Me.ListBox1.ColumnCount = 6
  Me.ListBox1.ColumnWidths = "50;50;40;50;60;50"
  Me.ListBox1.List = Rng.Value
  Set f = Sheets("bd")
  TblBD = Rng.Value
  Me.ListBox1.List = TblBD
  Me.ListBox1.ColumnCount = 6
  Me.ListBox1.ColumnWidths = "100;50;50;50;50;50"
  '--- ComboBox
  Set d = CreateObject("scripting.dictionary")
  d("*") = ""
  For i = 1 To UBound(TblBD)
    d(TblBD(i, 1)) = ""
  Next i
  temp = d.keys
  Me.ComboBox1.List = temp
  Me.ComboBox1 = "*"
End Sub

Private Sub ComboBox1_click()
  ColRecherche = 1
  clé = Me.ComboBox1: n = 0
  Dim Tbl()
  For i = 1 To UBound(TblBD)
    If TblBD(i, ColRecherche) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
        For k = 1 To UBound(TblBD, 2): Tbl(k, n) = TblBD(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Private Sub B_recup_Click()
  Application.ScreenUpdating = False
  Set f = Sheets("Result")
  n = ListBox1.ListCount
  Tbl = Me.ListBox1.List
  f.[A2].Resize(n) = Application.Index(Tbl, , 1)
  f.[C2].Resize(n) = Application.Index(Tbl, , 2)
  f.[F2].Resize(n) = Application.Index(Tbl, , 3)
End Sub

Private Sub B_recup2_Click()
  Application.ScreenUpdating = False
  Set f = Sheets("Result")
  n = ListBox1.ListCount
  Tbl = Me.ListBox1.List
  f.[J2].Resize(n, 3) = Application.Index(Tbl, Evaluate("Row(1:" & n & ")"), Array(1, 3, 6))
End Sub

Boisgontier

 

[Scorpio]

Re bonjour Mr Boisgontier,
C'est très aimable de votre part Mr Boisgontier, je n'ai pas de mérite en ce qui concerne les codes VBA, c'est un peut dure tous ca.
Je visite très souvent votre site "Formation Excel VBA" et je fouine pour trouver parfois quelques travaux intéressant, le souci, pour moi en tous les cas, parque je suis en Excel 2016, c'est de télécharger un classeur dans votre site, et souvent cela ne se télécharge plus, peut-être trop ancien, je suppose.
Enfin, merci pur tous, portez-vous bien, et à +++++

 

[BOISGONTIER]

>Le souci, pour moi en tous les cas, parque je suis en Excel 2016, c'est de télécharger un classeur dans votre site, et souvent cela ne se télécharge plus, peut-être trop ancien, je suppose.

???? donnez moi un exemple.

Boisgontier