Remplir une bulle ou zonne de teste ???

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, dec As Integer, lst As String, Salle As Range
On Error Resume Next
'si la cellule sélectionnée (Target) est située dans les plages B6:H6 et B14:H14
If Not Intersect(Target, Range("B6:H6,B14:H14")) Is Nothing Then
  'on relève le nom de la salle dans la cellule décalée sur la ligne du dessus (-1) et dans la même colonne(0)
  Set Salle = Target.Offset(-1, 0)
  'le décalage à appliquer (dec) est = au n° de ligne - 1 car la lecture se fera à partir de la ligne 1
  dec = Feuil2.Columns(1).Find(Salle, LookIn:=xlValues).Row - 1
  'boucle sur chaque cellule de Feuil2 contenant une valeur alphanumérique
  For Each cel In Feuil2.Rows(1).SpecialCells(xlCellTypeConstants)
    'si la cellule de la même colonne située (dec) plus bas n'est pas vide,
    'ajoute son contenu à la variable lst avec un retour chariot
    If Not cel.Offset(dec, 0) = "" Then lst = lst & vbCrLf & "   " & cel.Offset(dec, 0)
  Next
  'si lst n'est pas vide, ajoute en début le titre et l'astérisque qui permettra de le supprimer par la suite
  'si la liste correspondante est vide, ajoute simplement l'astérisque
  If Not lst = "" Then lst = "Utilisateurs" & lst & vbCrLf & vbCrLf & "*" Else lst = "*"
  dec = Feuil3.Columns(1).Find(Salle, LookIn:=xlValues).Row - 1
  For Each cel In Feuil3.Rows(1).SpecialCells(xlCellTypeConstants)
    If Mid(lst, InStr(lst, "*") + 1) <> "" Then lst = Replace(lst, "*", "Ordinateurs")
    If Not cel.Offset(dec, 0) = "" Then lst = lst & vbCrLf & "   " & cel.Offset(dec, 0)
  Next
  'supprime l'astérisque
  lst = Replace(lst, "*", "")
  'affiche la liste dans le msgbox
  If lst <> "" Then MsgBox lst, vbOKOnly, Target.Offset(-1, 0)
End If
End Sub