Try code like
Sub AAA()
Dim S As String
On Error Resume Next
S = ThisWorkbook.Worksheets(ActiveCell.Text).Name
If Err.Number = 0 Then
S = ActiveCell.Text & " (2)"
Else
S = ActiveCell.Text
End If
ActiveSheet.Name = Left(Replace(S, "/", vbNullString), 31)
End Sub
This will get rid of the "/" character and add "(2)" to the sheet name
if a sheet with the name in the active cell already exists. However,
if it is possible that the active cell may contain text that already
has a "(2)" suffix (e.g., activecell.text = "Google (2)"), the code
will rename the sheet "Google (2) (2)". If you want the sheet to be
renamed "Google (3)" instead, use the code below:
Sub AAA()
Dim S As String
Dim WS As Worksheet
Dim N As Long
Dim M As Long
S = Replace(ActiveCell.Text, "/", vbNullString)
On Error Resume Next
Set WS = ThisWorkbook.Worksheets(S)
If Err.Number = 0 Then
N = 1
Do Until False
N = N + 1
M = InStrRev(S, " (")
If M 0 Then
S = Left(S, M - 1) & " (" & CStr(N) & ")"
Else
S = S & " (" & CStr(N) & ")"
End If
Set WS = ThisWorkbook.Worksheets(S)
If Err.Number < 0 Then
ActiveSheet.Name = S
Exit Do
End If
Loop
Else
ActiveSheet.Name = S
End If
End Sub
Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
On Wed, 13 Jan 2010 09:47:31 -0800 (PST), al
wrote:
Sub SheetNameActivecell()
Application.ActiveSheet.Name = Left(Application.Substitute
(ActiveCell.Value, "/", ""), 31)
End Sub
Would also like to improve macro by adding codes which would allow to
name a sheet with (2) at end of an existing sheet name.
e.g if "Google" already exist - macro would rename sheet as "Google
(2)"
Thxs