liste deroulante resumant tous les onglets

Option Explicit
Option Compare Text 'la casse est ignorée
'---API Windows pour le fun---
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Private Sub Worksheet_Activate()
'mise à jour pour le cas où l'on a supprimé des feuilles
Worksheet_Change [E7]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E7,E9,E11,E13]) Is Nothing Then Exit Sub
Dim a, b$(), mem#(), i%, w As Worksheet, c As Range
Target.Select
a = Array("*" & [E7] & "*", [E9], [E11], [E13]) 'adaptable
ReDim b(UBound(a)): ReDim mem(UBound(a))
For i = 1 To UBound(a): mem(i) = 9 ^ 9: Next
For Each w In Worksheets
  If a(0) <> "**" And w.[C6] Like a(0) Then b(0) = b(0) & Chr(1) & w.Name
  For i = 1 To UBound(a)
    Set c = w.Range("C" & i + 6)
    If a(i) <> "" And c <> "" And Abs(c - a(i)) < mem(i) Then mem(i) = Abs(c - a(i)): b(i) = w.Name
  Next
Next
'---restitutions---
ComboBox1 = "": ComboBox1.Clear 'RAZ
If b(0) <> "" Then ComboBox1.List = Split(Mid(b(0), 2), Chr(1)) 'charge la liste
[F9] = b(1): [F11] = b(2): [F13] = b(3)
End Sub

Private Sub Combobox1_Change()
[E7].Activate
If ComboBox1.ListIndex = -1 Then
  ComboBox1 = ""
  SetCursorPos 100, 350 'pour le fun, le déplacement du pointeur fait apparaître la couleur jaune
Else
  Application.Goto Sheets(ComboBox1.Text).[C6]
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(ActiveCell, [F9,F11,F13]) Is Nothing Or ActiveCell = "" Then Exit Sub
With ActiveCell
  .Offset(, -1).Select
  Application.Goto Sheets(.Value).Cells(7 + (.Row - 9) / 2, 3)
End With
End Sub