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