Option Explicit
Private Sub Worksheet_Activate()
Dim T(), L As Long, Wsh As Worksheet, RngMenu As Range
On Error Resume Next
Set RngMenu = Me.[Menu]: If Err Then Set RngMenu = Me.[B2:C300]
On Error GoTo 0
RngMenu.ClearContents
ReDim T(1 To ThisWorkbook.Worksheets.Count - 1, 1 To 2)
For L = 1 To UBound(T, 1)
Set Wsh = ThisWorkbook.Worksheets(L + 1)
T(L, 1) = Wsh.Name
T(L, 2) = Wsh.[A1].Value
Next L
Set RngMenu = RngMenu.Resize(UBound(T, 1))
RngMenu.Value = T
Me.Names.Add "Menu", RngMenu
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Target = Intersect(Me.[Menu], Target)
If Target Is Nothing Then Exit Sub
If Target.Rows.Count <> 1 Then Exit Sub
ThisWorkbook.Worksheets(Intersect(Me.[Menu].Columns(1), Target.EntireRow).Value).Activate
End Sub