Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = [AA2].Address Then Call SetActiveSheetName
End Sub
' ======================================================
' ZVI: См. Worksheet_Change() в зоне формул модуля Лист1
' или альтернативный вариант Workbook_SheetChange() в модуле ЭтаКнига
Sub SetActiveSheetName()
Dim NewName As String, WsExist As Boolean
On Error Resume Next
' Считать новое имя листа
NewName = [AA2]
' Если новое имя = пусто, то ничего не делать
If Len(NewName) = 0 Then Exit Sub
' Проверить, есть ли уже лист с таким именем
With Worksheets(NewName): End With
WsExist = (Err = 0)
' Сбросить флаг ошибки (возникает, если листа с новым именем не существовало)
Err.Clear
' Отработать ввод нового имени
Application.EnableEvents = False
ActiveSheet.Name = NewName
If Err <> 0 Then
MsgBox "Имя '" & NewName & "' " _
& IIf(WsExist, "уже существует!", "ошибочно") & vbCrLf _
& "Введите другое имя", _
vbCritical, _
" Ошибка!"
' Вернуть предыдуще значение ячейки [А2]
Application.Undo
End If
Application.EnableEvents = True
End Sub