Macro alimentation de type recherchev

[chris6999]

Bonjour le Forum


Je souhaiterais pouvoir alimenter par l'intermédiaire d'une macro, des cellules de ma feuille Source à partir des éléments contenus dans une autre feuille (BD).
A partir de la ligne 5
Pour chaque ligne
Si la colonne A est non vide alors incrémenter dans la colonne I la valeur "Entreprise" présente dans la feuille BD.
à partir de la valeur commune "Client" (présent en colonne F de Source et en colonne A de BD).

J'avais récupéré un code mais il ne fonctionne que sur des cellules fixes.


Set c = Sheets("BD SAL").Columns("E").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole) ' si l'on a trouvé
If Not c Is Nothing Then

Range("I23") = c.Offset(0, 2)
End If
End If

Merci d'avance
Cordialement

 

[Guest]

Re : Macro alimentation de type recherchev

Bonjour,

Ceci devrait fonctionner. Boucle à partir du bas par commodité d'écriture.

Sub Entreprises()
    Dim shSource As Worksheet
    Dim plgRech As Range
    Dim Ligne As Long, Res As Variant
    Set shSource = Sheets("feuille source")
    With Sheets("BD")
        Set plgRech = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    With shSource
        For Ligne = .Range("F" & Cells.Rows.Count).End(xlUp).Row To 5 Step -1
            If .Cells(Ligne, 1) <> "" Then
                'utilisation de la fonction de feuille de calcul Equiv pour rechercher le premier nom prénom correspondant
                Res = Application.Match(.Range("F" & Ligne), plgRech, 0)
                If Not IsError(Res) Then .Range("I" & Ligne).Value = plgRech(Res, 2)
            End If
        Next
    End With
End Sub

A+

 

[chris6999]

Re : Macro alimentation de type recherchev

Bonjour

Cela fonctionne très bien. Je vais essayer de l'adapter à mon fichier réel

Merci encore
Bone soirée

Bonjour,

Ceci devrait fonctionner. Boucle à partir du bas par commodité d'écriture.

Sub Entreprises()
    Dim shSource As Worksheet
    Dim plgRech As Range
    Dim Ligne As Long, Res As Variant
    Set shSource = Sheets("feuille source")
    With Sheets("BD")
        Set plgRech = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    With shSource
        For Ligne = .Range("F" & Cells.Rows.Count).End(xlUp).Row To 5 Step -1
            If .Cells(Ligne, 1) <> "" Then
                'utilisation de la fonction de feuille de calcul Equiv pour rechercher le premier nom prénom correspondant
                Res = Application.Match(.Range("F" & Ligne), plgRech, 0)
                If Not IsError(Res) Then .Range("I" & Ligne).Value = plgRech(Res, 2)
            End If
        Next
    End With
End Sub

A+