Microsoft 365 Transfert sélection multiple Listbox

[Scorpio]

Bonjour à tous,
J'ai trouvé sur le net, ce classeur, dont je ne suis pas le créateur, hélas , mais, qui me serais bien utile,
Et, j'aimerais lorsque la sélection est crée, transférer cette sélection dans la feuille "RECUP".
Je vous en remercie d'avance et a++++
Scorpio

 

[cp4]

Bonjour Scorpio,

c'était assez simple pourtant

Private Sub CommandButton1_Click()
    Dim i As Integer, j As Byte, dl As Integer
    If ListBox2.ListCount > 0 Then
        With Sheets("recup")
            dl = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            For i = 0 To ListBox2.ListCount - 1
                For j = 0 To ListBox2.ColumnCount - 1
                    .Cells(dl + i, j + 1) = ListBox2.List(i, j)
                Next j
            Next i
        End With
    End If
End Sub

Bon courage pour la suite.

 

[danielco]

Bonjour,

Essaie :

Private Sub CommandButton1_Click()
    Dim Sh As Worksheet, Ligne As Integer, Plage As Range
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                With Sheets("BD")
                  Set Plage = .Range(.Cells(i + 2, 1), .Cells(i + 2, 7))
                End With
                With Sheets("RECUP")
                  Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                  .Cells(Ligne, 1).Resize(, 7).Value = Plage.Value
                End With
            End If
        Next i
    End With
End Sub

Daniel

 

[Scorpio]

Salut cp4 et danielco,
A oui, pour des pro comme vous, c'est du simple, pour moi, en VBA, je suis pas au top.
Dites, serais-t-il possible encore une petite correction.
En fait, lors d'un transfert, il faudrait supprimer le transfert précédent, pour n'accepter que le transfert réscent.
Merci beaucoup A+++

 

[danielco]

Private Sub CommandButton1_Click()
    Dim Ligne As Integer, Plage As Range
    With Sheets("RECUP")
      .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 7).Value = ""
    End With
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                With Sheets("BD")
                  Set Plage = .Range(.Cells(i + 2, 1), .Cells(i + 2, 7))
                End With
                With Sheets("RECUP")
                  Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                  .Cells(Ligne, 1).Resize(, 7).Value = Plage.Value
                End With
            End If
        Next i
    End With
End Sub

Daniel

 

[cp4]

Salut cp4 et danielco,
A oui, pour des pro comme vous, c'est du simple, pour moi, en VBA, je suis pas au top.
Dites, serais-t-il possible encore une petite correction.
En fait, lors d'un transfert, il faudrait supprimer le transfert précédent, pour n'accepter que le transfert réscent.
Merci beaucoup A+++

Private Sub CommandButton1_Click()
    Dim i As Integer, j As Byte, dl As Integer
    If ListBox2.ListCount > 0 Then
        With Sheets("recup")
            dl = .Cells(Rows.Count, 1).End(xlUp).Row    'renvoi derniere ligne non vide en colonne A
            If dl > 1 Then .Range(.Cells(2, 1), .Cells(dl, 7)).Clear   'suppression precedentes lignes

            For i = 0 To ListBox2.ListCount - 1
                For j = 0 To ListBox2.ColumnCount - 1
                    .Cells(2 + i, j + 1) = ListBox2.List(i, j)    'boucle de transfert
                Next j
                .Cells(2 + i, 7).Value = .Cells(2 + i, 7).Value * 1    'conversion format nombre
            Next i
        End With
    End If
MsgBox "Transfert terminé!", vbOKOnly + vbInformation, "TRANSFERT"
End Sub

 

[Scorpio]

cp4 re salut.
Merci beaucoup pour ce coup de main, sympa.
Je dis encore merci à tous le Forum, vous êtes des pro Excel, on a besoin de personnes comme vous.
A bientôt et bon week End