Переименовка листов по CodeName

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Long
If Not Intersect(Range("M2:M32"), Target) Is Nothing Then
    For Each iCell In Target
        Select Case iCell.Address(0, 0)
            Case "M2": sh = 3
            Case "M3": sh = 4
            Case "M4": sh = 5
            Case "M5": sh = 6
            Case "M6": sh = 7
            Case "M7": sh = 8
            Case "M8": sh = 9
            Case "M9": sh = 10
            Case "M10": sh = 11
            Case "M11": sh = 12
            Case "M12": sh = 13
            Case "M13": sh = 14
            Case "M14": sh = 15
            Case "M15": sh = 16
            Case "M16": sh = 17
        End Select
        Sheets(sh).Name = IIf(iCell <> "", iCell.Value, WorksheetFunction.Rept(" ", sh))
    Next
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Long
If Not Intersect(Range("M2:M3"), Target) Is Nothing Then
    For Each iCell In Target
        Select Case iCell.Address(0, 0)
            Case "M2": sh = 3
            Case "M3": sh = 4
        
        End Select
        Sheets(sh).Name = IIf(iCell <> "", iCell.Value, WorksheetFunction.Rept(" ", sh))
    Next
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Long
If Not Intersect(Range("M2:M32"), Target) Is Nothing Then
    For Each iCell In Target
        Select Case iCell.Address(0, 0)
            Case "M2": sh = 3
            Case "M3": sh = 4
            Case "M4": sh = 5
            Case "M5": sh = 6
            Case "M6": sh = 7
            Case "M7": sh = 8
            Case "M8": sh = 9
            Case "M9": sh = 10
            Case "M10": sh = 11
            Case "M11": sh = 12
            Case "M12": sh = 13
            Case "M13": sh = 14
            Case "M14": sh = 15
            Case "M15": sh = 16
            Case "M16": sh = 17
        End Select
        Sheets(sh).Name = IIf(iCell <> "", iCell.Value, WorksheetFunction.Rept(" ", sh))
    Next
End If
End Sub

Sub tst()
    Dim arr, sh&
    arr = Array(List1, List10, List11)
    sh = 1
    arr(sh).Activate 'или arr(sh).Name=....
End Sub

'   FullFlashka, попробуйте этот код. _
 _
    Я его уже добавил в ваш файл (в приложении). _
    Попробуйте выделить ячейку с данными в столбце "G" _
    на листе Главная
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Not Intersect(Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row), _
        Target) Is Nothing And Target.Cells.Count = 1 Then
    
If Target.Value <> "" Then
    For i = 1 To Worksheets.Count
        With Worksheets(i)
            
            ' вариант 1: _
                МОЖНО СДЕЛАТЬ ДАЖЕ так, когда и названия листов не важны, _
                и не важно где они находятся. _
                Важно только, чтобы: _
                    - точно совпадали названия номеров договоров, и _
                    - чтобы № договора сидел в одинаковой ячейке, _
                      у вас она, кажется, всегда будет [D4] _
                Вариант рабочий, пробуйте, но _
                если случайно будут в книге договора с одинаковыми номерами, _
                этот код найдёт всегда только первый попавшийся договор. _
                Но не трагедия, всё можно (почти) ...
            
            If .Range("D4").Value = Target.Value Then
                .Activate
                .Range("B2").Activate
                Exit Sub
            
            ' вариант 2: _
                через .Name, но чтобы это работало, _
                вы должны обеспечивать правильные названия листов при их создании ... _
                вариант рабочий (на тех листах, что я переименовал), можно попробовать
            
''                If .Name = Replace(Target.Value, "/", "-") Then
''                    .Activate
''                    .Range("B2").Activate
''                    Exit Sub
            
            ' вариант 3: _
                через .CodeName, и тоже, чтобы это работало, _
                вы прежде должны обеспечивать правильные названия .CodeName листов при их создании ... _
                что немножко сложнее второго варианта. Если хотите, дорабатывайте.
                
            'If .CodeName = Replace(Target.Value, "/", "_") Then        ' например
            '    .Activate  ...
                            
 
            Else
                If i = Worksheets.Count Then
                    MsgBox "Договора № " & "'" & Target.Value & "'" & " в книге не найдено."
                End If
            End If
        End With
    Next i
End If
End If
 
End Sub