Sous cellules

Option Explicit

' Feuille BONS
Const lideb = 10      ' premiere ligne
Const co = "E"        ' colonne à cliquer

' Feuille "tableaux"
Const FD = "Feuil1"   ' nom de la feuille
Const coD = "A"       ' colonne montant
Const coE = "B"       ' colonne libelle
Const ht = 12.75      ' hauteur d'une ligne de la listbox - à adapter

' cette fonction renvoie l'adresse du tableau - s est le contenu de la cellule cliquée
Public Function AdrPlage(s As String) As String
Dim obj As Object, li1 As Long, li2 As Long, lifin As Long
' cherche s dans la colonne coD de la feuille FD
Set obj = Sheets(FD).Columns(coD).Find(s, , , xlWhole)
' si s non trouvé renvoie une chaine vide
If obj Is Nothing Then
  AdrPlage = ""
' sinon
Else
  ' li1 est la ligne dans FD où s a été trouvé
  li1 = obj.Row
  ' lifin est la dernière ligne non vide de la colonne coD (feuille FD)
  lifin = Sheets(FD).Range(coD & Rows.Count).End(xlUp).Row
  ' recherche de la ligne de fin du tableau : li2
  ' initialisation de li2
  li2 = li1 + 1
  ' tant que li2<= lifin et que la cellule (li2,coD) n'est pas vide on in cremebnte li2
  While Sheets(FD).Range(coD & li2) <> "" And li2 <= lifin
    li2 = li2 + 1
  Wend
  ' la plage commence en ligne li1+1 et se finit en li2 ( sur 2 colonnes coD et coE)
  AdrPlage = Sheets(FD).Range(coD & li1 + 1 & ":" & coE & li2).Address
End If
End Function

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim des As String, adr As String, nbli As Long, lifin As Long
' si la cellule cible est en colonne co
If Not Intersect(Target, Columns(co)) Is Nothing Then
  ' si la ligne cliquée est avant lideb on quiite sans rien faire
  If Target.Row < lideb Then Exit Sub
  ' sinon
  ' des = contenu de la cellule cliquée
  des = Target.Value
  ' adr = adresse du tableau correspondant calculé par la fonction AdrPlage
  adr = AdrPlage(des)
  ' si adr vide - des non trouvé - on quitte sans rien faire - on peut faire apparaitre un message d'erreur
  If adr = "" Then MsgBox "Erreur": Exit Sub
  ' remplissage et formatage de la listbox
  With ListBox1
    ' ListFillRange est l'adresse du tableau
    .ListFillRange = FD & "!" & adr
    ' nombre de lignes du tableau
    nbli = Sheets(FD).Range(adr).Rows.Count
    ' alignement de la listbox à gauche et sous la cellule cliquée
    .Left = Target.Left
    .Top = Target.Top + Target.Height + 5
    ' hauteur de la listbox - c'est là qu'il faudra peut être modifier ht
    ListBox1.Height = nbli * ht
    ' si la listbox est visible on a cache sinon on la montre
    ListBox1.Visible = Not ListBox1.Visible
    ' on passe à la ligne suivante pour debloquer le curseur
    Target.Offset(1, 0).Select
  End With
End If
End Sub