Cells.Find et plusieurs mots à rechercher

dela · 7 Février 2012

Bonjour à tous, je suis très content de rejoindre ce forum. 😀

J'aimerai vote aide svp, je me lance un peu sur le VBA et malgré mes recherches sur d'ancien post je n'ai pas trouvé
de solution.

Je souhaite créé une application pour rechercher des mots dans la colonne A afin de les copiers ensuite dans la colonne B.

J'ai donc enregistrer une macro (avec le petit boutton en bas) et j'ai utilisé Ctrl+F. Ca marche plutôt bien mais le problème c'est que si ma macro ne trouve pas le mot recherché il y a une erreur 🙁

Ca fais une petite semaine que j'essaye mais sans succès, notamment avec Application.DisplayAlerts=False

Voici mon code

Code:

Sub coller()
'
' coller Macro
'

'
    Range("A:A,G:G").Select
    Selection.ClearContents
    Range("A1").Select
    ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:= _
        False
    Range("A1").Select
    Cells.Find(What:="N° d'affaire", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Fournisseur", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    Range("G2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Identifiant du Point de Livraison", After:=ActiveCell, _
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-33
    Range("G3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Etat du point de livraison", After:=ActiveCell, LookIn _
        :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-42
    Range("G4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Alimentation", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-36
    Range("G5").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Catégorie du client", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-39
    Range("G6").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Civilité", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-60
    Range("G7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Nom", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-60
    Range("G8").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Prénom", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-60
    Range("G9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Téléphone", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.Find(What:="Téléphone du client", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-60
    Range("G10").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Option de prestation", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-96
    Range("G11").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Type d'offre", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-96
    Range("G12").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Structure de comptage", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-102
    Range("G13").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Puissance souscrite demandée", After:=ActiveCell, LookIn _
        :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-108
    Range("G14").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Cells.Find(What:="Code tarif DISCO", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-105
    Range("G15").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        
        Cells.Find(What:="Standard de réalisation", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-138
    Range("G16").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Cells.Find(What:="Commentaire", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-147
    Range("G17").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-21
    Range("A1").Select
End Sub

Merci à tous

JONEY76 · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

On error resume next 'poursuivre si erreur

Application.DisplayAlerts=False'c'est juste pour ne pas voir les message d'avertissement

dela · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Oh 1000 merci

ca marche impec, encore merci

ciao

dela · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

j'ai une autre question 😱
je souhaite créé une ZoneTexte avec des valeurs dedans et pouvoir copier son contenus juste en cliquant dessus. c'est possible.

encore merci

JNP · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Bonjour le fil et bienvenue Dela 🙂,
Si je peux me permettre,

Code:

On Error Resume Next

n'est a utiliser que dans certains cas extrèmes, car textuellement, il ignore les erreurs, donc ta macro a de fortes chances de faire n'importe quoi 😱...
La bonne méthode, c'est de tester en stockant dans une variable le résultat, vérifier si le résultat existe, et seulement à ce moment-là, copier 🙄...
Du fait, tant qu'on est en macro, autant en profiter, donc si je ne me suis pas trompé, celle-ci fera aussi bon usage, sans arrêt de la gestion d'erreur, et en étant un tantinet plus courte 😛...

Code:

Sub coller()
Dim I As Integer, Cellule As Range, Tablo
Range("A:A,G:G").ClearContents
Tablo = Array("N° d'affaire", "Fournisseur", "Identifiant du Point de Livraison", _
    "Etat du point de livraison", "Alimentation", "Catégorie du client", _
    "Civilité", "Nom", "Prénom", "Téléphone du client", "Option de prestation", _
    "Type d'offre", "Structure de comptage", "Puissance souscrite demandée", _
    "Code tarif DISCO", "Standard de réalisation", "Commentaire")
For I = 0 To UBound(Tablo)
Set Cellule = Cells.Find(What:=Tablo(I), LookIn:=xlFormulas, LookAt:=xlPart)
If Not Cellule Is Nothing Then Cellule.Copy Range("G" & I + 1)
Next I
End Sub

Bonne soirée 😎

dela · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Merci JNP pour ta collaboration 😀

C'est vrai que ton code est très court, mais comment je pourrais dans ce cas pour copier les valeurs recherchés et trouvés dans d'autre cellule ?

dela · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Je vais essayé de suite et je te tiens au courant. merci

JNP · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Re 🙂,

dela à dit:
je souhaite créé une ZoneTexte avec des valeurs dedans et pouvoir copier son contenus juste en cliquant dessus. c'est possible.

La question manque de clarté 🙄...
Zone texte 😕 ? Plusieurs cellules contigües, une zone dessinée, ???
Comme spécifié dans la charte que je ne doute pas que tu ai lu 😱, il serait bon de faire un petit fichier exemple avec ce que tu souhaites faire 😛...
Bonne suite 😎

JNP · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Re 🙂,

dela à dit:
C'est vrai que ton code est très court, mais comment je pourrais dans ce cas pour copier les valeurs recherchés et trouvés dans d'autre cellule ?

Ton code actuel ne cherche qu'une série de valeurs 🙄...
Après, si tu veux en chercher plusieurs, il va falloir avoir un fichier d'exemple (anonymisé...) pour voir comment les données se présentent et comment on peut les traiter 😛...
Bonne nuit 😎

dela · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Oui pardon voici mon fichier

En fait, je veux récupérer quelque donnés parmis d'autres suite a un copier/coller, grace a la Macro je recherche les mots et si je les trouves je les copies puis je les colles dans d'autres cellules afin d'y effectuer des prelevements de mots .... 😕 ok voici mon fichier

JNP · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

Re 🙂,
C'est bien, tu as modifié ton fichier, je ne suis pas sur que ce messieur aurait été très content de recevoir des coups de fil 😱...
Macro corrigée

Code:

Sub coller()
Dim I As Integer, Cellule As Range, Tablo
Range("G:G").ClearContents
Tablo = Array("N° d'affaire", "Fournisseur", "Identifiant du Point de Livraison", _
    "Etat du point de livraison", "Alimentation", "Catégorie du client", _
    "Civilité", "Nom", "Prénom", "Téléphone du client", "Option de prestation", _
    "Type d'offre", "Structure de comptage", "Puissance souscrite demandée", _
    "Code tarif DISCO", "Standard de réalisation", "Commentaire")
For I = 0 To UBound(Tablo)
Set Cellule = Cells.Find(What:=Tablo(I), LookIn:=xlFormulas, LookAt:=xlPart)
If Not Cellule Is Nothing Then
Cellule.Copy Range("G" & I + 1)
Range("G" & I + 1) = Trim(Replace(Range("G" & I + 1), Tablo(I), ""))
End If
Next I
Range("A:A").ClearContents
End Sub

qui t'évitera même de retravailler le texte 😛...
Bonne nuit 😎

dela · 7 Février 2012

Re : Cells.Find et plusieurs mots à rechercher

C'est bien, tu as modifié ton fichier, je ne suis pas sur que ce messieur aurait été très content de recevoir des coups de fi

😀 c'est clair

Merci 1000 fois pour ton aide, je te tiens au courant de la suite dès que j'aurai testé

Passe une très bonne nuit et encore merci 😎

Effectuez une recherche sur Excel Downloads...

Cells.Find et plusieurs mots à rechercher

dela

XLDnaute Nouveau

JONEY76

XLDnaute Occasionnel

dela

XLDnaute Nouveau

dela

XLDnaute Nouveau

JNP

XLDnaute Barbatruc

dela

XLDnaute Nouveau

dela

XLDnaute Nouveau

JNP

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

dela

XLDnaute Nouveau

Pièces jointes

JNP

XLDnaute Barbatruc

dela

XLDnaute Nouveau

Discussions similaires

Nous accordons de l'importance à votre vie privée