自动修改工作表名称为单元格中的值

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 Const strNAMECELL As String = "A1"
 Const strERROR As String = "在单元格中是无效的工作表名称"
 Dim strSheetName As String
 
 With Target
   If Not Intersect(.Cells, Range(strNAMECELL)) Is Nothing Then
     strSheetName = Range(strNAMECELL).Value
     If Not strSheetName = "" Then
       On Error Resume Next
       Me.Name = strSheetName
       On Error GoTo 0
       If Not strSheetName = Me.Name Then _
         MsgBox strERROR & strNAMECELL
     End If
   End If
 End With
End Sub