XL 2019 Etirer vers la droite une recherche via VBA (macro)

[Jo Mortu]

Bonjour à tous,

Je vous sollicite car je souhaiterai créer une macro qui me permette de réaliser une rechercher V pour étirer vers la droite, ce qui me permettrait de compléter l'ensemble de mes colonnes.

Si vous avez une idée?

Je vous communique un exemple de fichier:
-> L'onglet BDD final: correspond à mon fichier final
-> L'onglet Source: le fichier source avec toutes infos que je souhaite rapatrier

Merci par avance de votre retour.

Bonne journée

 

[sylvanu]

Bonjour Jo Mortu,
En PJ un essai. La macro s'active lorsqu'on sélectionne la feuille "BDD finale".

Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    With Sheets("BDD finale")
        For L = 2 To .Range("A65500").End(xlUp).Row
            If Not IsError(Application.Match(.Cells(L, "A"), Sheets("Source").Range("A:A"), 0)) Then
                IndexR = Application.Match(.Cells(L, "A"), Sheets("Source").Range("A:A"), 0)
                For C = 2 To 8
                    .Cells(L, C) = Sheets("Source").Cells(IndexR, C)
                Next C
            End If
        Next L
    End With
End Sub

 

[Jo Mortu]

Bonjour Jo Mortu,
En PJ un essai. La macro s'active lorsqu'on sélectionne la feuille "BDD finale".

Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    With Sheets("BDD finale")
        For L = 2 To .Range("A65500").End(xlUp).Row
            If Not IsError(Application.Match(.Cells(L, "A"), Sheets("Source").Range("A:A"), 0)) Then
                IndexR = Application.Match(.Cells(L, "A"), Sheets("Source").Range("A:A"), 0)
                For C = 2 To 8
                    .Cells(L, C) = Sheets("Source").Cells(IndexR, C)
                Next C
            End If
        Next L
    End With
End Sub

Bonsoir Sylvanu,

Merci beaucoup pour votre retour. J'essaie et je reviens vers vous.

Bonne soirée

 

[Jo Mortu]

Bonjour Jo Mortu,
En PJ un essai. La macro s'active lorsqu'on sélectionne la feuille "BDD finale".

Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    With Sheets("BDD finale")
        For L = 2 To .Range("A65500").End(xlUp).Row
            If Not IsError(Application.Match(.Cells(L, "A"), Sheets("Source").Range("A:A"), 0)) Then
                IndexR = Application.Match(.Cells(L, "A"), Sheets("Source").Range("A:A"), 0)
                For C = 2 To 8
                    .Cells(L, C) = Sheets("Source").Cells(IndexR, C)
                Next C
            End If
        Next L
    End With
End Sub

Bonsoir Sylvanu,

Je reviens vers vous pour vous remercier, çà fonctionne. C'est parfait.

J'ai adapté le code pour la faire fonctionner avec un bouton.

Merci beaucoup.

Bonne soirée