Bonjour!
Grace à job75, j'ai non seulement une macro fonctionnelle pour trouver des valeurs dans d'autres fichiers, mais j'ai aussi appris un peu comment fonctionne le VBA.
Il s'agit d'une macro événementielle, activée dès qu'on entre une valeur dans une case de la colonne. J'aimerais maintenant compléter cette macro avec un petit détail supplémentaire. J'aimerais que la formule en I2 soit copiée dans la cellule à gauche de la cellule active.
Un autre moyen de l'expliquer ou de le coder serait de copier I2 dans la cellule I de la rangée active.
Après 5 heures de recherche et une vingtaine d'essais, je crois que je vais encore demander un petit coup de main. J'avais bien trouvé une façon qui fonctionne, mais elle consistait à coller chaque fois cette formule sur la totalité des 750 cellules qui doivent la contenir. Une solution lourde et pas très élégante. Quelqu'un pourrait m'aider à faire mieux?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 9 Or Target.Count > 1 Then Exit Sub
Dim chemin$, fichier$, feuille$, adr$, fich$, form$, i As Variant
chemin = "P:\dossier\registres_de_production\" 'à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
feuille = "Feuil1" 'nom des feuilles sources, à adapter
If fichier = "" Then MsgBox "Aucun fichier .xls* trouvé...": Exit Sub
adr = Target.Address(, , xlR1C1, True)
Do While fichier <> ""
fich = Replace(fichier, "'", "''") 's'il y a une apostrophe dans le nom
form = "'" & chemin & "[" & fich & "]" & feuille & "'!"
i = ExecuteExcel4Macro("MATCH(" & adr & "," & form & "C9,0)") 'formule de liaison
If IsNumeric(i) Then
Target(1, 4) = ExecuteExcel4Macro("INDEX(" & form & "C10," & i & ")")
Target(1, 2) = ExecuteExcel4Macro("INDEX(" & form & "C13," & i & ")")
Exit Do 'on sort à la 1ère occurrence
End If
fichier = Dir 'fichier suivant
Loop
If IsError(i) Then Union(Target(1, 0), Target(1, 2)) = "" 'RAZ
AJOUTER ICI
End Sub
Grace à job75, j'ai non seulement une macro fonctionnelle pour trouver des valeurs dans d'autres fichiers, mais j'ai aussi appris un peu comment fonctionne le VBA.
Il s'agit d'une macro événementielle, activée dès qu'on entre une valeur dans une case de la colonne. J'aimerais maintenant compléter cette macro avec un petit détail supplémentaire. J'aimerais que la formule en I2 soit copiée dans la cellule à gauche de la cellule active.
Un autre moyen de l'expliquer ou de le coder serait de copier I2 dans la cellule I de la rangée active.
Après 5 heures de recherche et une vingtaine d'essais, je crois que je vais encore demander un petit coup de main. J'avais bien trouvé une façon qui fonctionne, mais elle consistait à coller chaque fois cette formule sur la totalité des 750 cellules qui doivent la contenir. Une solution lourde et pas très élégante. Quelqu'un pourrait m'aider à faire mieux?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 9 Or Target.Count > 1 Then Exit Sub
Dim chemin$, fichier$, feuille$, adr$, fich$, form$, i As Variant
chemin = "P:\dossier\registres_de_production\" 'à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
feuille = "Feuil1" 'nom des feuilles sources, à adapter
If fichier = "" Then MsgBox "Aucun fichier .xls* trouvé...": Exit Sub
adr = Target.Address(, , xlR1C1, True)
Do While fichier <> ""
fich = Replace(fichier, "'", "''") 's'il y a une apostrophe dans le nom
form = "'" & chemin & "[" & fich & "]" & feuille & "'!"
i = ExecuteExcel4Macro("MATCH(" & adr & "," & form & "C9,0)") 'formule de liaison
If IsNumeric(i) Then
Target(1, 4) = ExecuteExcel4Macro("INDEX(" & form & "C10," & i & ")")
Target(1, 2) = ExecuteExcel4Macro("INDEX(" & form & "C13," & i & ")")
Exit Do 'on sort à la 1ère occurrence
End If
fichier = Dir 'fichier suivant
Loop
If IsError(i) Then Union(Target(1, 0), Target(1, 2)) = "" 'RAZ
AJOUTER ICI
End Sub
