Copier contenu d'une listbox dans une nouvelle feuille

Bonjour à tous,

Je travail depuis quelques temps maintenant sur un projet contenant une base de donnée, un formulaire de saisie et un formulaire de recherche. Débutant en excel et vba, j'ai copier par ci par là des bouts de codes que j'ai tenté de comprendre pour monter un code qui correspond à ma demande. Je bloque sur une étape et je souhaiterais vous demander votre aide svp.

Problématique :

Dans le formulaire "RECHERCHER", je souhaiterais que lorsque l'on clique sur une ligne dans ListBox1, cette ligne se copie dans la feuille "Recup" en s'ajoutant et sans écraser les précédents ajouts.

Idéalement, j'aurais voulu que l'on puisse sélectionner des lignes et cliquer sur un bouton qui vient les copier dans la feuille "Recup" sans écraser les précédentes copies, mais bon..

Ci-joint, un document fictif de mon projet avec ma dernière tentative.

Je vous remercie par avance du temps que vous consacrerez à ma problématique.

N'hésitez pas à me poser des questions si j'ai manqué de clarté dans mes explications

Pauline

Bonjour pauline

Si j'ai bien compris dans ta recherche, remplace ListBox1_Click() par cette partie de code

Private Sub ListBox1_Click()
Dim I As Integer

I = Application.WorksheetFunction.Match(ListBox1.List(ListBox1.ListIndex, 1), Worksheets("bd").Range("B:B"), 0)
lig = Sheets("Recup").Range("B" & Rows.Count).End(xlUp).Row + 1
Sheets("bd").Range("A" & I & ":C" & I).Copy Destination:=Sheets("Recup").Range("A" & lig)
Sheets("bd").Range("E" & I).Copy Destination:=Sheets("Recup").Range("D" & lig)

End Sub

A+

Un grand MERCI Patty !

Cela fonctionne et cela me réjouie !

J'ai ajouté ceci au code afin de l'adapter a ma demande :

Private Sub ListBox1_Click()
Dim I As Integer

I = Application.WorksheetFunction.Match(ListBox1.List(ListBox1.ListIndex, 1), Worksheets("bd").Range("B:B"), 0)
lig = Sheets("Recup").Range("B" & Rows.Count).End(xlUp).Row + 1
Sheets("bd").Range("A" & I & ":C" & I).Copy Destination:=Sheets("Recup").Range("A" & lig)
Sheets("bd").Range("E" & I).Copy Destination:=Sheets("Recup").Range("D" & lig)

Sheets("bd").Range("F" & I).Copy Destination:=Sheets("Recup").Range("E" & lig)
Sheets("bd").Range("G" & I).Copy Destination:=Sheets("Recup").Range("F" & lig)
Sheets("bd").Range("J" & I).Copy Destination:=Sheets("Recup").Range("G" & lig)
Sheets("bd").Range("K" & I).Copy Destination:=Sheets("Recup").Range("H" & lig)
End Sub

Suite a cette démarche, ... est-il possible d'empêcher la copie, de la première ligne de la base de donnée dans la feuille "Recup", lorsque l'on clique sur le bouton "Tout" de l'outil de recherche (permettant d'afficher a nouveau toute la base de donnée dans la listbox) svp ?

Edit /

Le problème qui se pose maintenant est que lorsque j'effectue une recherche, la Listbox1 sélectionne une ligne et du coup celle-ci se copie automatiquement dans la feuille "Recup" alors que je ne l'ai pas choisie. Ca fausse ma liste à récuprer du coup. Je me dis qu'il faut peut-être désactiver la selection, sans pour autant la bloquer. Cependant, je ne sais pas comment faire.. :/

Pauline,

Je propose d'ajouter le code suivant au formulaire "userform2" sur l'évènement "click" du bouton "b_recup" :

Private Sub b_recup_Click()
    Const cNbCols = 8
    Dim oSheet As Excel.Worksheet
    Dim lIndex As Long, lNB As Long, lCol As Long
    Dim lRow As Long
    Dim aSelection() As Variant
    With Me.ListBox1
        For lIndex = 0 To .ListCount - 1
            If .Selected(lIndex) Then
                lNB = lNB + 1
                ReDim Preserve aSelection(cNbCols, 1 To lNB)
                For j = 0 To cNbCols - 1
                    aSelection(j, lNB) = .List(lIndex, j)
                Next
            End If
        Next
    End With
    Set oSheet = ThisWorkbook.Worksheets("Recup")
    With oSheet
        lRow = .UsedRange.Rows.Count + 1
        .Range(.Cells(lRow, 1), .Cells(lRow + UBound(aSelection, 2) - 1, UBound(aSelection) + 1)) = WorksheetFunction.Transpose(aSelection())
    End With

End Sub

Bonjour Gérard,

Merci de ta réponse

J'ai recopié ta proposition de code, cependant il ne se passe rien lorsque je clique sur le bouton "recup" :/

Cette proposition est elle a ajouter à la proposition de patty ?

Pauline,

J'ai testé le code et chez moi. Il fonctionne et ajouter bien plusieurs lignes à la fois comme tu le voulais.

Petite précision : dans les propriétés de la listbox , il est nécessaire de passer "MultiSelect" à la valeur 1.

Autre précision, j'ai effacé les lignes vides présentes dans la feuille "Recup" pour ne laisser subsister que la ligne d'entêtes.

Non, le code que je t'ai proposé est une voie différente de celle proposée par Patty qui semble bien répondre à ton besoin. Donc tu peux oublier ma proposition.

J'ai recommencé et cela fonctionne !

Je te remercie très grandement car cette proposition correspond davantage à ce que je souhaitais obtenir !

Patty, ta proposition est très bien, cependant il en découle d'autres problématiques que je ne saurais pas gérer.

J'ai cependant un petit souci de copie : quand je clique sur le bouton "recup", les lignes se copie au milieu de la page "Recup" et non en dessous de la ligne des en-tête..

Non je crois qu'en fait c'est bon.

Oui en fait, j'ai compris : il faut supprimer les lignes et non les données des lignes, sinon ca s'inscrit en milieu de page.

Merci Gérard !