Rechercher une valeur sur plusieurs lignes

Bonjour,

j'ai fais un code qui me permet de rechercher une valeur entré dans une inputbox.
Si ce qui est entré dans l'inputbox correspond à une valeur de ma cellule B alors je
sélectionne la valeur en cellule A qui est le nom d'un fichier. J'ouvre ensuite ce fichier
et je recherche une valeur ($cahier) en colonne B. Si la valeur est présente alors je copie certaines
valeurs de cette ligne dans ma première feuille de mon classeur sinon j'affiche un message
d'erreur.

Le problème est que la valeur que je recherche dans la feuille ouverte est parfois présente sur
plusieurs lignes.
J'aimerais donc que mon programme récupère toutes les valeurs demandé lorsque $cahier est présent.
J'ai essayé avec plusieurs code mais impossible de trouver la solution.

Si quelqu'un pouvait m'aiguiller svp.

Sub recherche()

Dim i As Long
Dim j As Long
Dim l As Long
Dim req As String
Dim Fichier As String
Dim CheminFichier As String
Dim celluletrouvee As Range
Dim indice As String
Dim ligne As Long
Dim col As Long

CheminFichier = "C: ..."

re:

req = InputBox("Renseignez un nom")

If req = "" Then
    MsgBox "Vous n'avez rien saisie"
    GoTo re
End If

If req <> "" Then

Application.ScreenUpdating = False

i = 2
j = 2
l = 1

    Do While Sheets("donnees").Cells(i, 2).Value <> ""
    
    
        If req = Sheets("donnees").Cells(i, 2).Value Then
        
            Fichier = Sheets("donnees").Cells(i, 1).Value
        
            Workbooks.Open (CheminFichier & Fichier)
                
                indice = "$cahier"
       
                 Set celluletrouvee = Range("B16:B100").Find(indice, lookat:=xlWhole)
                
                If celluletrouvee Is Nothing Then
                    MsgBox ("Aucun nom ne correspond")
                Else
                
                    ligne = celluletrouvee.Row 'k
                    col = celluletrouvee.Column                  
                   
kol:                
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, l).Value = Cells((ligne - 1), (col + 1)).Value                  
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 1)).Value = Cells((ligne - 1), (col + 3)).Value                    
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 2)).Value = Cells((ligne - 1), (col + 4)).Value                    
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, (l + 3)).Value = Cells((ligne - 1), (col + 5)).Value                    
                    Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, 5).Value = Workbooks("Programme.xlsm").Sheets("donnees").Cells(i, 1).Value


		    ligne = ligne + 1

                        If celluletrouvee <> "" Then
                        
                         Do While Workbooks("Programme.xlsm").Sheets("Inv").Cells(j, l).Value <> ""
                           
                            l = l + 1
                            
                          Loop
                                    
                            GoTo kol
                    
                           
                         End If


  		Workbooks(Fichier).Close (True)

                End If
                 
                
        j = j + 1

        End If

        i = i + 1
    Loop
end if

end Sub