Bonjour,
J'ai réussi avec ce code là. Je le poste histoire de ne pas mettre le sujet en "résolu" sans y apporter un semblant de réponse.
Comme normalement il est intégré à un code beaucoup plus vaste, j'ai repris quelques variables mais il faut certainement l'adapter un peu au besoin.
Y a certainement plus simple mais c'est pour le moment la seule solution que j'ai trouvé.
Option Explicit
Sub Rech_Partout()
Dim s_Filtre As String
Dim r_Cell As Range
Dim r_Cell_2 As Range
Dim i_01 As Integer
Dim i_02 As Integer
Dim i_Cpt As Integer
Set r_Cell = Range("A5")
i_01 = 6
i_Cpt = 0
i_02 = 300 'limite de recherche
On Error GoTo Result '<= permet de sortir et de donner les résultats de la recherche
'première recherche
Cells.Find(What:=s_Filtre, After:=r_Cell, LookIn:=xlFormulas2, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
i_Cpt = 1
Set r_Cell_2 = Selection
Do 'boucle sur les recherches suivantes
If i_Cpt > i_02 Then
GoTo Result
ElseIf Selection.Row = i_01 Then '<= permet de décaler à la ligne de dessous
i_01 = i_01 + 1
Set r_Cell = Selection
ElseIf r_Cell_2.Address = r_Cell.Address Then '<= cas où la cellule est la même, fin de recherche
GoTo Result
ElseIf r_Cell_2.Row < r_Cell.Row Then '<= cas où on est remondé dans la recherche
GoTo Result
ElseIf r_Cell_2.Row = r_Cell.Row Then '<= cas où la recherche est sur la même ligne
i_Cpt = i_Cpt + 1
Set r_Cell = Selection
ElseIf r_Cell_2.Row = r_Cell.Row + 1 Then '<= cas où la recherche est sur la ligne suivante
i_Cpt = i_Cpt + 1
Set r_Cell = Selection
Else
Rows(r_Cell.Row + 1 & ":" & r_Cell_2.Row - 1).EntireRow.Hidden = True
i_Cpt = i_Cpt + 1
Set r_Cell = Selection
End If
Cells.FindNext(After:=ActiveCell).Activate
Set r_Cell_2 = Selection
Loop
Result:
'test fin de procédure
If Err.Number = 91 Then
MsgBox ("Recherche sans résultat. Fin de procédure")
ElseIf Err.Number = 0 Then
Rows(r_Cell.Row + 1 & ":" & l_CellBas).EntireRow.Hidden = True
msgbox (i_Cpt & " valeurs trouvées")
End If
On Error GoTo 0
End Sub