Macro cherche puis insère ligne

[seb01]

Bonjour à tous,

Je souhaite créer une macro qui cherche une donnée répétitive dans une colonne.
Dès que cette donnée est trouvée, il faut insérer une ligne juste en dessous de celle-ci.

Cette macro je l'ai simplement réalisée avec l'enregistreur.

Cependant je souhaiterai que cette macro soit jouée uniquement du début de la colonne jusqu'à la fin de la dernière donnée trouvée en bas de colonne. Sans boucle vers le haut de la colonne.

Pourriez-vous m'aider svp. Merci

Voici le code actuel:

Sub Macro1()
'
' Macro1 Macro
'

'
    Cells.Find(What:="TRFNONREF", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("86:86").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

 

[CPk]

Re : Macro cherche puis insère ligne

Bonjour, un petit lien utile (selon moi) avec un exemple de macro avec find et findnext. Dans votre cas, c'est après "Do" qu'il faut mettre en place votre insertion de ligne.

Ce lien n'existe plus

 

[Robert]

Re : Macro cherche puis insère ligne

Bonjour Seb, CPk, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)

LI = 86 'initialise la ligne LI
'définit la recherche R
Set R = Columns(ActiveCell.Column).Find(What:="TRFNONREF", After:=ActiveCell, LookIn:=xlValues, _
   LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
   MatchCase:=False, SearchFormat:=False)
If Not R Is Nothing Then 'condition : si au moins une occurrence st trouvée
    PA = R.Address 'définit l'adresse PA de la première occurence trouvée
    Do 'exécute
        Rows(LI).Copy 'copy la ligne LI
        Cells(R.Row + 1, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'la colle en dessous de la ligne de l'occurrence trouvée
        LI = LI + 1 'incrémente l ligne LI
        Set R = Columns(ActiveCell.Column).FindNext(R) 'redéfinitla recherche R (occurrecne suivante)
    Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
End If 'fin de la condition
End Sub

 

[seb01]

Re : Macro cherche puis insère ligne

Merci beaucoup pour les info.

J'ai pris l'exemple de Robert.

Dans ce cas je crois comprendre qu'il y a un souci avec l'initialisation de LI.

Dans la macro de Robert, LI = 86 car cela correspond bien à ma ligne à insérer dans mon fichier.
Cependant en pratique la valeur de 86 peut changer et devrait être: LI = PA + 1

J'ai essayé mais j'ai une erreur.

Vu que j'ai difficile à débugger, je fais appel à vous.

 

[seb01]

Re : Macro cherche puis insère ligne

Merci beaucoup pour les info.

J'ai pris l'exemple de Robert.

Dans ce cas je crois comprendre qu'il y a un souci avec l'initialisation de LI.

Dans la macro de Robert, LI = 86 car cela correspond bien à ma ligne à insérer dans mon fichier.
Cependant en pratique la valeur de 86 peut changer et devrait être: LI = PA + 1

J'ai essayé mais j'ai une erreur.

Vu que j'ai difficile à débugger, je fais appel à vous.

Ok j'ai trouvé.

Comme ceci:

Sub Macro1()
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)


'définit la recherche R
Set R = Columns(ActiveCell.Column).Find(What:="TRFNONREF", After:=ActiveCell, LookIn:=xlValues, _
   LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
   MatchCase:=False, SearchFormat:=False)
If Not R Is Nothing Then 'condition : si au moins une occurrence st trouvée
    PA = R.Address 'définit l'adresse PA de la première occurence trouvée
    Do 'exécute
        
        Cells(R.Row + 1, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'la colle en dessous de la ligne de l'occurrence trouvée
       ' LI = PA + 1 'incrémente l ligne LI
        Set R = Columns(ActiveCell.Column).FindNext(R) 'redéfinitla recherche R (occurrecne suivante)
    Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
End If 'fin de la condition
End Sub

 

[Robert]

Re : Macro cherche puis insère ligne

Re,

Oui, tu as raison le code est bien plus fiable comme ça...
Il marchait avec LI + 1 uniquement si les lignes insérées se trouvaient avant la ligne 86 (mes rapides tests), mais après, ça ne marchait plus... Bien vu !

Comme PA est une adresse et tu as besoin d'une ligne donc :

LI = R.Row + 1

Toutefois, comme ta recherche débute à la ligne active, ton code reste aléatoire. Sans le fichier, difficile de t'en dire plus...