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