Sub CreateNamedWorksheet()
  Dim wb As Workbook, nws As Worksheet, NewName As String
  Dim ws As Worksheet, cws As Worksheet
  
  Set wb = ThisWorkbook
  Set cws = wb.ActiveSheet
  If ActiveCell.Value <> "" Then
    NewName = ActiveCell.Value
    For Each ws In wb.Worksheets
      If ws.Name = NewName Then
        MsgBox ("The name " & NewName & " is already in use. No new worksheet added.")
        End
      End If
    Next ws
    Set nws = wb.Worksheets.Add
    nws.Name = NewName
  Else
    MsgBox "The active cell has no value to name the new worksheet"
    End
  End If
  cws.Activate  'Use a ' right before this line to select the new worksheet.
 
End Sub