Renvoi de donnee, via une recherche

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$11" Then Exit Sub
If Target.Value = "" Then Exit Sub

Dim References() As String
Dim ValCherchee As String
Dim Nom_Feuil As String
Dim Plage As String
Dim dl As Long
Dim Test As Boolean
Dim i As Integer

ValCherchee = Target.Value
Nom_Feuil = "BaseDonnée"
With Sheets(Nom_Feuil)
    dl = .Range("A" & Rows.Count).End(xlUp).Row
End With
Plage = "A1:A" & dl
'---------------------------------------------------------------
Test = FindAll(ValCherchee, Sheets(Nom_Feuil), Plage, References())
'---------------------------------------------------------------

If Test = True Then
    Ligne = Range("S" & Rows.Count).End(xlUp).Row
    If Ligne > 28 Then Range("S29:X" & Ligne).Clear
    Ligne = 28
    For i = 1 To UBound(References)
        With Sheets(Nom_Feuil)
            Ligne = Ligne + 1
            Range("S" & Ligne).Value = .Range("A" & References(i)).Value
            Range("T" & Ligne).Value = .Range("C" & References(i)).Value
            Range("U" & Ligne).Value = .Range("D" & References(i)).Value
            Range("V" & Ligne).Value = .Range("E" & References(i)).Value
            Range("W" & Ligne).Value = .Range("F" & References(i)).Value
            Range("X" & Ligne).Value = .Range("G" & References(i)).Value
        End With
    Next
End If
End Sub

Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean
' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the1 given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------
On Error GoTo Err_Trap
Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find
' -----------------
' Clear the Array
' -----------------
Erase arMatches
Set rFnd = oSht.Range(sRange).Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart)

If Not rFnd Is Nothing Then
rFirstAddress = rFnd.Address
Do Until rFnd Is Nothing
iArr = iArr + 1
ReDim Preserve arMatches(iArr)
arMatches(iArr) = rFnd.Row 'rFnd.Address pour adresse complete ' rFnd.Row Pour N° de ligne
Set rFnd = oSht.Range(sRange).FindNext(rFnd)
If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
Loop
FindAll = True
Else
' ----------------------
' No Value is Found
' ----------------------
FindAll = False
End If
' -----------------------
' Error Handling
' -----------------------
Err_Trap:
If Err <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
Err.Clear
FindAll = False
Exit Function
End If
End Function

Option Explicit
'-----
Sub rechercher_svt_reference()
Dim Ref As String
Dim Nbre_ref As Integer, Ligne As Integer, T_ref

Application.ScreenUpdating = False
 Ref = Sheets("Offre de prix").Range("B11")
 If Ref = "" Then GoTo vide
 '---- recherche des Références
 With Sheets("basedonnée")
     Nbre_ref = Application.CountIf(.Columns("A"), Ref)
     If Nbre_ref = 0 Then GoTo inconnu
     Ligne = .Columns("A").Find(Ref, Range("A1"), xlValues).Row
     'mémorisation de toutes les données données de la référence
     T_ref = .Range(.Cells(Ligne, "A"), Cells(Ligne + Nbre_ref - 1, "F"))
 End With
 '-------- Restitution des données sélectionnées dans l'offre de prix
 With Sheets("Offre de prix")
     .Range("S29:X15000").Clear
     With .Range("S29").Resize(Nbre_ref, 6)
          .Value = T_ref
          .Borders.Weight = xlThin
          .applicate
     End With
 End With
 
 Exit Sub

'----gestion erreurs
vide:
     MsgBox " aucune référence saisie !", vbCritical
     Exit Sub
inconnu:
     MsgBox "Référence inconnue dans la base de données", vbCritical
End Sub