Microsoft 365 VBA: chercher les cellules contenant un début de chaines de caractère et puis les copier dans un autre tableau

Narta

XLDnaute Nouveau
Bonjour,
Je suis entrain de faire une macro pour une application et je me suis bloquée dans un détail.
En fait, l'objectif est de balayer une plage de cellules, de chercher les cellules dont le contenu contient une chaine de caractère. Si la condition est vraie, copier ces cellules dans un autre tableau.
ci dessous le code que j'ai écrit:

Sub Recherche()
Dim Cellule As Range
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String

Valeur_Cherchee = "*toto*"
Set PlageDeRecherche = ActiveSheet.Range("B1:D17")
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookIn:=xlValues, LookAt:=xlPart)


For Each Cellule In PlageDeRecherche

If Cellule.Value = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlPart) Then Cellule.Copy Destination:=Range("B16777").End(xlUp)(2)

Next Cellule

End Sub

Sauf qu'avec ce code, dés qu'il trouve la première cellule contenant toto, il copie cette cellule et il fait pas les autres cellule contenant toto. Sachant que dans mon fichier excel, j'ai plusieurs cellules contenant toto.
En fait c comme si la variable Trouve devient fixe pour lui.
Auriez vous des idées SVP
 

Wayki

XLDnaute Impliqué
Salut,
Ta plage est elle assez grande ?
Je vois qu'elle fait que 17lignes.
Ensuite tu déclare trouve, pourquoi tu l'utilises pas ?
If cellule.value = trouve then...
Juste que tu peux mettre aussi :
PlageDeRecherche.Find(what:=Valeur_Cherchee, LookAt:=xlPart)
J ai pas de PC là pour tester mais essaye ça déjà 😉
A +
 

Narta

XLDnaute Nouveau
Salut,
Oui j'ai choisi une plage pas grande pour que je puisse tester.
sinon pour la variable Trouve, je l'avais juste remplacer par son expression dans la boucle for each pour voir s'il y'aura une différence ou pas.
mais sinon, elle etait utilisé comme ci-dessous et le résultat était le même:
If Cellule.Value =Trouve Then Cellule.Copy Destination:=Range("B16777").End(xlUp)(2)
ci-dessous le petit fichier test
Merci
 

Pièces jointes

  • test.xlsx
    9 KB · Affichages: 5

Discussions similaires

Réponses
8
Affichages
861
Réponses
12
Affichages
541

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou