Macro to name worksheet based on cell A1

Private Sub Worksheet_Change(ByVal Target As Range)
Activesheet.Name = Range("A1").Value
End Sub

Sub ChangeSheetNames()
dim ws as Worksheet
For each ws in Worksheets
ws.Name = ws.Range("A1").Value
Next ws
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Sh.Name = Sh.Range("A1")
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim i As Long, myChr As String, skipChr As String
    Dim newStr As String, oldStr As String, ws As Worksheet
    
    skipChr = "_"
    oldStr = Range("A1").Value
    newStr = ""
 
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        ' Check to see if length of A1 is <= 31
        If Len(oldStr) > 31 Then
            oldStr = Left(oldStr, 31)
        End If
 
      ' Check to see if sheet name already exists as typed
        On Error Resume Next
        Set ws = Worksheets(oldStr)
        On Error GoTo 0
        If Not ws Is Nothing Then
            MsgBox "A sheet with the name """ & oldStr & """ already exists."
            Exit Sub
        End If
 
      ' Check to see if A1 is now blank (e.g. deleted cell A1)
        If Range("A1").Value = "" Then
            Exit Sub
        Else
          ' Check each character for special characters
          ' that cannot be used in Sheet names
            For i = 1 To Len(oldStr)
                myChr = Mid(oldStr, i, 1)
                Select Case myChr
                    Case Is = ":", "/", "\", "?", "[", "]", Chr(42)
                        oldStr = Replace(Expression:=oldStr, _
                            Find:=myChr, Replace:=skipChr)
                        newStr = oldStr
                    Case Else
                        newStr = oldStr
                End Select
            Next i
        End If
 
        ' Check to see if new (altered) sheet name exists
        On Error Resume Next
        Set ws = Worksheets(newStr)
        On Error GoTo 0
        If Not ws Is Nothing Then
            MsgBox "A sheet with the name """ & newStr & """ already exists."
            Exit Sub
        End If
 
    ActiveSheet.Name = newStr
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim newName As String
If Target.Address = "$A$1" Then
    newName = CStr(Target.Value)
    If newName <> vbNullString Then
        On Error Resume Next
            Sh.Name = newName
            If Err <> 0 Then
                If Sh.Parent.Sheets(newName).Index < 1 Then
                    MsgBox "Illegal Sheet name."
                Else
                    MsgBox "That name already exists."
                End If
                Application.Undo
            End If
        On Error GoTo 0
    End If
End If
End Sub