Rechercher valeur dans colonne + copier autre valeur à côté

Bonjour,

Sans doute la plupart d'entre vous trouveront ma demande basique, mais je n'y connais pas grand-chose en VBA. Voici :

J'ai un long fichier contenant du texte dans une colonne intitulée "Observations", et une colonne vide à côté intitulée "Plan(s) existant(s)". Je souhaite obtenir une macro permettant de :

1) Recherche le mot "plan" dans la colonne contenant le texte ;

2) Si le mot a été trouvé :

21) arrêter la recherche ;

22) passer dans la cellule voisine de la colonne "Plan(s) existant(s)" ;

23) y inscrire le mot "Plan(s)".

3) Poursuivre la procédure jusqu'à la fin de la colonne.

Merci de votre aide et bonne journée !

Moussette

514plan.zip (88.87 Ko)

Bonjour Mousette, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set O = Worksheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne A de l'onglet O
TV = O.Range("A1:B" & DL) 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    ReDim Preserve TL(1 To 2, 1 To K) 'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
    TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV (= Transposition)
    'si TV(I,1) n'est pas vide, renvoie "plan(s)" ou rien en fonction du mot "plan" trouvé ou pas dans la donnée ligne I colonne 1 de TV
    If TV(I, 1) <> "" Then TL(2, K) = IIf(InStr(1, TV(I, 1), "plan", vbTextCompare) > 0, "plan(s)", "")
    K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
Next I 'prochaine ligne de la boucle
'si K est supérieure à 1, renvoie dans A2 redimensionnée de l'onglet O, le tableau TL transposé
If K > 1 Then O.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

Bonjour ThauTheme,

Je viens d'essayer ta macro et elle marche parfaitement. En revanche, je ne suis pas sûr d'avoir tout compris !

Merci beaucoup, en tous cas. Je vais gagner beaucoup de temps.

Moussette

Rechercher des sujets similaires à "rechercher valeur colonne copier cote"