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

Jo Mortu

XLDnaute Nouveau
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
 

Pièces jointes

  • Exemple Pilotes.xlsx
    10.3 KB · Affichages: 3
Solution
Bonjour Jo Mortu,
En PJ un essai. La macro s'active lorsqu'on sélectionne la feuille "BDD finale".
VB:
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

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Jo Mortu,
En PJ un essai. La macro s'active lorsqu'on sélectionne la feuille "BDD finale".
VB:
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
 

Pièces jointes

  • Exemple Pilotes.xlsm
    16.1 KB · Affichages: 5

Jo Mortu

XLDnaute Nouveau
Bonjour Jo Mortu,
En PJ un essai. La macro s'active lorsqu'on sélectionne la feuille "BDD finale".
VB:
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

XLDnaute Nouveau
Bonjour Jo Mortu,
En PJ un essai. La macro s'active lorsqu'on sélectionne la feuille "BDD finale".
VB:
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
 
Haut Bas