Cells.Find et plusieurs mots à rechercher

D

dela

XLDnaute Nouveau
Bonjour à tous, je suis très content de rejoindre ce forum. :D

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
 
Trier par date Trier par votes
JNP

JNP

XLDnaute Barbatruc
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 :eek:...
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 :rolleyes:...
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 :p...
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 :cool:
 
Vote positif 0 Vote négatif
D

dela

XLDnaute Nouveau
Re : Cells.Find et plusieurs mots à rechercher

Merci JNP pour ta collaboration :D

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 ?
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
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.
Cliquez pour agrandir...
La question manque de clarté :rolleyes:...
Zone texte :confused: ? Plusieurs cellules contigües, une zone dessinée, ???
Comme spécifié dans la charte que je ne doute pas que tu ai lu :eek:, il serait bon de faire un petit fichier exemple avec ce que tu souhaites faire :p...
Bonne suite :cool:
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
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 ?
Cliquez pour agrandir...
Ton code actuel ne cherche qu'une série de valeurs :rolleyes:...
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 :p...
Bonne nuit :cool:
 
Vote positif 0 Vote négatif
D

dela

XLDnaute Nouveau
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 .... :confused: ok voici mon fichier
 

Pièces jointes

  • Classeur13.xlsm
    24.5 KB · Affichages: 86
Dernière édition:
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
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 :eek:...
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 :p...
Bonne nuit :cool:
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
163
Francky79
F
S
  • Question
XL 2016 Inversion jour / mois
Réponses
2
Affichages
157
dysorthographie
dysorthographie
F
  • Résolu(e)
Microsoft 365 Commentaire cellule dans TextBox dans UserForm
Réponses
4
Affichages
369
Francky79
F
Phillip
  • Question
XL 2016 excel VBA : recherche dans une colonne sans la sélectionner
Réponses
4
Affichages
266
job75
job75
Phillip
  • Question
XL 2016 Définir un nom en vba
Réponses
3
Affichages
303
Phillip
Phillip
Y
  • Résolu(e)
XL 2013 Recherche qui fonctionne avec le texte et non la Value
Réponses
3
Affichages
369
youguybass
Y
D
  • Question
Microsoft 365 Problème avec remplacer . par ,
Réponses
3
Affichages
259
de_hanstrapp
D
N
  • Résolu(e)
XL 2019 transformation de cordonnée GPS
Réponses
14
Affichages
813
sylvanu
sylvanu
lebarbo
  • Résolu(e)
XL 2019 [Résolu] Problème VBA Find
Réponses
6
Affichages
1 K
lebarbo
lebarbo
B
  • Question
Microsoft 365 Remplacer "." par "," avec VBA sans qu'il considère que c'est des milliers si ça ne commence par "0."
Réponses
1
Affichages
271
Eric KERGRESSE
E

Membres actuellement en ligne

6 membres et 48 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 085
Messages
2 085 196
Membres
102 814
dernier inscrit
JLGalley