VBA RechercheV de plusieurs cellules dans plusieurs colonnes
Bonjour à tous,
Je cherche depuis deux jours à construire une macro et cela sans sucées. Il faut dire que je suis débutant en VBA. J’ai donc besoin de votre aide. Je précise que c’est ma première demande sur un forum . je vais essayer d’être le plus possible précis.
Explication du contexte :
L’onglet nommé « PMC_TSA » est une synthèse des différents achats dont le nom des items achetés est en colonne M depuis la ligne 6 à une ligne variable (le nombre de ligne d’item est inscrit en A1).
Exemple :
Sheets(« PMC_TSA » ).range(« M6 “) = Item a
Sheets(« PMC_TSA » ).range(« M7 “) = Item b
Sheets(« PMC_TSA » ).range(« M8 “) = Item c
…
Parmi d’autres onglets, le fichier possède des onglets nommés « PO_BC », « PO_BC .B», « PO_BC .C»… dont le nombre est variable. Ces onglets sont des bons de commandes par fournisseur qui contiennent entre autre le nom du fournisseur dans la cellule U6, et le nom des items qui lui sont commandés depuis la colonne D en ligne 26 jusqu’à une dernière ligne variable (le nombre de ligne d’item est inscrit en A1).
Exemple :
Sheets(« PO_BC» ).range(« U6 “) = fournisseur1
Sheets(« PO_BC» ).range(« D26 “) = Item b
Sheets(« PO_BC» ).range(« D35 “) = Item X
….
Sheets(« PO_BC.B» ).range(« U6 “) = fournisseur2
Sheets(« PO_BC.B» ).range(« D26 “) = Item a
Sheets(« PO_BC.B» ).range(« D29“) = Item L
….
Je cherche à faire :
1/ Je veux faire la recherche ligne par ligne de chaque Item présents dans la feuille « PMC_TSA », dans la colonne M, depuis la ligne 6 à une ligne variable…
2/ dans chaque onglets commençant par « PO_BC », onglets par onglets…
3/ si valeur trouvé prendre le nom de chaque fournisseur en U6 pour touts les onglets ou le nom de l’item est présent
4 / concaténer les résultats est mettre, le nom de ces fournisseurs dans la cellule à droite de la colonne M dans l’onglet « PMC_TSA » puis passer à la ligne suivante.
Exemple
Colonne M Colonne N
Item a Fournisseur1 / fournisseur3
Item b Fournisseur1 / fournisseur2
Item c Fournisseur1 / Fournisseur2 / fournisseur3
Voici mon code qui ne fonctionne pas
Sub Test_nomfournisseur()
Dim Trouve As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String
Dim x As Integer
Dim i As Integer
Dim Ws As Worksheet
Dim result As String
For Each Ws In ThisWorkbook.Worksheets
For i = 1 To Sheets.Count
If Left(Ws(i).Name, 5) = "PO_BC" Then
Set PlageDeRecherche = Ws(i).Range("D:L")
For x = 6 To Sheets("PMC_TSA").Range("A1").Value Step 1
Valeur_Cherchee = Sheets("PMC_TSA").Cells(x, 13)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
If Trouve Is Nothing Then
GoTo prochain
Else
result = Sheets(i).Name
Sheets("PMC_TSA").Cells(x, 13).Offset(0, 2) = Sheets("PMC_TSA").Cells(x, 13).Offset(0, 2) & result & " / "
prochain:
End If
Next x
Next i
Next Ws
End Sub
Merci à tous pour votre aide
Bonjour et bienvenue sur le forum
Tes explications auront beau être excellentes, si tu ne joins pas ton fichier, je doute fort que quelqu'un soit en mesure de te faire une proposition...
Mais sait-on jamais ...
Bye !
Merci gmb pour ta réponse,
sur tes conseils, je joins un fichier épuré de la majorité des macros.
La macro qui contient le code suivant, se nomme RechercheV_TSA et le resultat doit être affiché en colonne AG de l'onglet PMC_TSA.
Cordialement
Sub RechercheV_TSA()
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String
Dim x As Integer
Dim i As Integer
Dim Ws As Worksheet
Dim result As String
For Each Ws In ThisWorkbook.Worksheets
For i = 1 To Sheets.Count
If Left(Ws(i).Name, 5) = "PO_BC" Then
Set PlageDeRecherche = Ws(i).Range("D:L")
For x = 6 To Sheets("PMC_TSA").Range("A1").Value Step 1
Valeur_Cherchee = Sheets("PMC_TSA").Cells(x, 13)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
If Trouve Is Nothing Then
GoTo prochain
Else
result = Ws(i).Range("U6").Value
Sheets("PMC_TSA").Cells(x, 13).Offset(0, 20) = Sheets("PMC_TSA").Cells(x, 13).Offset(0, 20) & result & " / "
prochain:
End If
Next x
End If
Next i
Next Ws
End Sub
Bonjour à tous,
A tête reposée, j'ai amélioré mon code. Résultat, j'y suis presque. J'arrive à concaténer le nom des fournisseurs dans l'onglet ("PMC_TSA") dans la colonne M pour la 6eme ligne. Quelqu'un serait'il comment faire glisser la formule pour réaliser l’opération sur toute les lignes du dessous?
Cordialement
Sub RechercheV_TSA()
Dim i As Integer
Dim x As Integer
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String
Dim Ws As Worksheet
For i = 1 To Sheets.Count
If Left(Sheets(i).Name, 5) = "PO_BC" Then
For x = 6 To Sheets("PMC_TSA").Range("A1").Value Step 1
Valeur_Cherchee = Sheets("PMC_TSA").Cells(x, 13)
Set PlageDeRecherche = Sheets(i).Range("D:L")
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
If Trouve Is Nothing Then
Exit Sub
Else
result = Sheets(i).Range("U6").Value
Sheets("PMC_TSA").Cells(x, 33) = Sheets("PMC_TSA").Cells(x, 33) & result & " / "
End If
Next x
End If
Next i
End Sub
Bonjour à tous,
Ce qui est bien avec VBA, c'est qu'il y a toujours une solution. A force d'essai, je viens enfin de trouver une macro qui fonctionne. Je la met en dessous pour tous ceux qui en auront besoin.
Sub RechercheV_TSA()
Dim i As Integer
Dim x As Integer
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String
Dim Ws As Worksheet
'je met à zero les cellules
Sheets("PMC_TSA").Range(Range("AG6"), Range("AG6").Offset(Range("A1").Value - 1, 0)).Select
Selection.ClearContents
For i = 1 To Sheets.Count
If Left(Sheets(i).Name, 5) = "PO_BC" Then
For x = 6 To Sheets("PMC_TSA").Range("A1").Value + 5 Step 1
Valeur_Cherchee = Sheets("PMC_TSA").Cells(x, 13)
If Valeur_Cherchee <> "" Then
Set PlageDeRecherche = Sheets(i).Range("D:L")
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
If Trouve Is Nothing Then
GoTo suivant
Else
result = Sheets(i).Range("U6").Value
Sheets("PMC_TSA").Cells(x, 33) = Sheets("PMC_TSA").Cells(x, 33) & result & " / "
End If
End If
suivant:
Next x
End If
Next i
End Sub
Bonjour
Un essai à tester : pas sûr que j'aie bien compris.
Te convient-il ?
Bye !