Sub NameList()
Dim n As Name, txt$, tbl() As String, nom As String, nbr As String, Elem As Byte
' En minuscule
Const LookupName$ = "baseht;option"
txt = "Liste des Beses et Option avec leur référence"
For Each n In ThisWorkbook.Names
tbl = Split(LookupName, ";")
For Elem = 0 To UBound(tbl)
If InStr(LCase(n.Name), tbl(Elem)) Then
Application.Goto reference:=Range(n.RefersTo)
nbr = CInt(Right(CStr(n.RefersTo), 2)) 'isole les 4 derniers chiffre
nom = Range("A" & nbr).End(xlUp).Offset(0, 1).Value
txt = txt & vbCrLf & n.NameLocal & " " & nom
End If
Next
Next
MsgBox txt
' nom = Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value
End Sub