Recherche valeur horizontalement et verticalement (sur plusieurs feuilles)

Bonjour.

Premier message sur ce forum qui m'aide depuis que j'ai débuté en VBA. Je me trouve bloqué pour une macro que je voudrais codé pour mon travail. J'ai un fichier excel avec des emplacements pour gérer un stock.

J'ai une liste de référence sur la "feuil1", en colonne de A2 à A20 par exemple, que je copie tous les matins.

Je voudrais qu'en face de chaque référence, dans la colonne B, avoir la valeur de l'emplacement associé, que j'ai dans un autre fichier excel, avec 4 feuilles.

La complexité est que sur ces feuilles, dans une colonne j'ai plusieurs emplacements possible. Je joins une capture pour l'explication.

Ma référence de produit recherchée peut se située dans les cases grisées sur la capture.

Si elle est en A2, A3 et A4 je voudrais avoir en retour "frigo", si elle est en A6, A7 et A8 je voudrais avoir "étagère" ..etc. et cela sur 4 feuilles.

Je suis parti sur une méthode mais étant débutant je ne trouve pas de solution ....

Merci à vous pour votre aide ! Bon dimanche.

Salut DagnyT,

Première règle : joindre un fichier (nous n'avons pas de boule de cristal) en prenant soin de produire une feuille avec le résultat voulu

A+

Merci à vous !

Voici un fichier exemple, c'est vrai que ça sera plus simple.

A noter que la feuille "A chercher" sera sur un autre fichier excel (mais je pourrai modifier le code si besoin, je pense pouvoir le faire)

Salut DagnyT,

une première approche...
- un double-clic sur la feuille de recherche démarre la macro ;
- un clic dans la colonne [A] efface les résultats de recherche en ['B].

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim rCel As Range, iOK%
Cancel = True
'
On Error Resume Next
Cells.Borders.LineStyle = xlLineStyleNone
Range("A1:B" & Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = 1
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    iOK = 0
    For y = 2 To Sheets.Count
        With Sheets(y)
            Set rCel = .Cells.Find(what:=Range("A" & x).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
            If Not rCel Is Nothing Then
                For Z = rCel.Row To 1 Step -1
                    If Not (IsNumeric(.Cells(Z, rCel.Column))) Then _
                        iOK = 1: _
                        Range("A" & x).Offset(0, 1).Value = .Cells(Z, rCel.Column): _
                        Exit For
                Next
                Exit For
            End If
            If iOK = 0 Then Range("A" & x).Offset(0, 1).Value = "Non trouvé"
        End With
    Next
Next
On Error GoTo 0
'
End Sub

A+

Bonjour !

Merci pour votre aide, ça fonctionne parfaitement !

Par contre je pensais pouvoir comprendre le code au premier regard mais il va falloir que je me penche dessus plus en profondeur ... :)

Encore merci j'ai compris le code. Je ne pense pas être capable d'en re-écrire un pareil ... Avec l'expérience peut être

Une petite demande d'update, serait il possible de supprimer la valeur dans les feuilles, une fois qu'elle a été trouvé et copiée dans la feuille "A chercher" ?

Quelle valeur ? La référence, j'imagine ?

Oui exactement.

Une fois que "3094" est trouvé et que l'emplacement est renseigné sur ma feuil1.

Je voudrais enlever "3094" de la feuille où il est ("cuisine1" par exemple), pour libéré la cellule et pouvoir y mettre une autre valeur.

Je n'arrive pas à modifier votre code avec un "ClearContents" par exemple. C'est pas facile de reprendre un code même si je comprends votre logique.

Salut DagnyT,

le code, modifié. J'en ai profité pour supprimer la variable iOK, histoire que tu creuses un peu plus la tête...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim rCel As Range
Cancel = True
'
On Error Resume Next
Cells.Borders.LineStyle = xlLineStyleNone
Range("A1:B" & Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = 1
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    Range("A" & x).Offset(0, 1).Value = "Non trouvé"
    For y = 2 To Sheets.Count
        With Sheets(y)
            Set rCel = .Cells.Find(what:=Range("A" & x).Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
            If Not rCel Is Nothing Then
                rCel = ""
                For Z = rCel.Row To 1 Step -1
                    If Not (IsNumeric(.Cells(Z, rCel.Column))) Then _
                        Range("A" & x).Offset(0, 1).Value = .Cells(Z, rCel.Column): _
                        Exit For
                Next
                Exit For
            End If
        End With
    Next
Next
On Error GoTo 0
'
End Sub

A+

Bonjour !

Merci encore pour ton retour, ça fonctionne

Et j'ai bien aimé le fait de me gratter les cheveux de nouveau, j'ai compris le nouveau code, il n'y avait pas de gros changements !

D'ailleurs au passage j'ai découvert l'utilisation du "%" grâce au iOK dans le premier code.

Et j'ai modifié le fait que la liste se supprime quand je clique dans la colonne A, car pour faire un copier/coller ce n'était pas pratique