Copier coller suivant enregistrement

Bonjour,

Dans le fichier joint, je souhaiterai en cliquant sur le bouton lister de l'onglet prénom trouver tous les enregistrements correspondant de la colonne A dans l'onglet Adhérents puis coller la ligne entière dans l'onglet récap.

Merci beaucoup de votre aide.

Bonjour,

Une piste :

Sub Test()

    Dim FePre As Worksheet
    Dim FeAdh As Worksheet
    Dim FeRec As Worksheet

    Dim Plage1 As Range
    Dim Plage2 As Range
    Dim Cel1 As Range
    Dim Cel2 As Range
    Dim Adr As String
    Dim Ligne As Long

    Set FePre = Worksheets("Prénom")
    Set FeAdh = Worksheets("Adhérents")
    Set FeRec = Worksheets("Récap")

    With FePre: Set Plage1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
    With FeAdh: Set Plage2 = .Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)): End With

    For Each Cel1 In Plage1

        Set Cel2 = Plage2.Find(Cel1.Value, , xlValues, xlWhole)

        If Not Cel2 Is Nothing Then

            Adr = Cel2.Address

            Ligne = FeRec.Cells(Rows.Count, 1).End(xlUp).Row + 1

            Do

                FeRec.Range(FeRec.Cells(Ligne, 1), FeRec.Cells(Ligne, 21)).Value = FeAdh.Range(FeAdh.Cells(Cel2.Row, 1), FeAdh.Cells(Cel2.Row, 21)).Value

                Ligne = Ligne + 1

                Set Cel2 = Plage2.FindNext(Cel2)

            Loop While Cel2.Address <> Adr

        End If

    Next Cel1

End Sub

Bonjour,

Ton code fonctionne sur le document joint, mais ( oui il y a un mais ) en l'adaptant à mon fichier lors du transfert de données dans la copie des éléments trouvés, il me les colle en format scientifique ... Je ne comprends pas pourquoi .

une idée ?

cdlt

Bonjour,

Sans le classeur original je ne sais que dire !

Testes avec cette ligne de code que tu mets à la fin de la procédure que je t'ai précédemment posté :

FeRec.Cells.SpecialCells(xlCellTypeConstants).NumberFormat = "General"