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

74fichier-excel.zip (282.87 Ko)

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

53fichier-excel.zip (293.38 Ko)

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 !

147fichier-excel-v1.zip (294.17 Ko)
Rechercher des sujets similaires à "vba recherchev colonnes"