Recherche parti d'une cellule et résultats multiples

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim Fe_1 As Worksheet
    Dim Fe_2 As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String
    Dim Lig As Long
    Dim Col As Long
   
    'seulement B2
    If Target.Address(0, 0) <> "B2" Then Exit Sub
   
    On Error GoTo Fin 'gestionnaire d'erreur
   
    Set Fe_1 = Worksheets("Feuil1")
    Set Fe_2 = ActiveSheet
   
    'défini la plage sur toute la feuille
    Set Plage = DefPlage(Fe_1)
   
    'commence la recherche
    Set Cel = Plage.Find(Target.Value, , xlValues, xlPart)
   
    'si trouvé...
    If Not Cel Is Nothing Then
       
        Application.EnableEvents = False 'gel des événements
   
        Adr = Cel.Address
       
        Do
           
            'recherche la dernière colonne non vide où se trouve la cellule contenant la valeur cherchée
            Col = Fe_1.Cells(Cel.Row, Columns.Count).End(xlToLeft).Column
           
            With Fe_2
           
                'recherche de la première cellule vide (+1) sur la colonne A de la feuille active
                Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
               
                'si inférieur à la ligne 3 donc commence à 3 (valeur cherchée en B2 !)
                If Lig < 3 Then Lig = 3
               
                'récupère les valeurs
                .Range(.Cells(Lig, 1), .Cells(Lig, Col)).Value = Fe_1.Range(Fe_1.Cells(Cel.Row, 1), Fe_1.Cells(Cel.Row, Col)).Value
               
            End With
           
            Set Cel = Plage.FindNext(Cel)
           
        Loop While Cel.Address <> Adr
       
    End If
   
Fin:
   
    Application.EnableEvents = True
   
End Sub

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range
   
    On Error GoTo Fin
   
    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With
   
    Exit Function
   
Fin:

    Set DefPlage = Nothing

End Function