Rename Multiple Sheets from a List of Available Names
 

Hello Experts,

I am using Windows XP/Office 2003 and have the following problem:

I have a Time Sheet Workbook with several sheets starting from 01 to
050.. (the number of sheets will vary)

In this workbook I have a Sheet Name Employees as follows

Column A
Row 1 Name
Row 2 Mr. A
Row 3 Mr. B
Row 4 Mr. C
...
...

etc etc


I wish to achieve the following through a macro

1) Rename each Sheet viz 01, 02. ..till end with the First Name from
Employees Sheet eg. 01 becomes Mr. A, 02 becomes Mr. B.. and so on till
the last employees name.

2) And copy Name of Employees in Address B5 .. means the respective
sheet name will also be shown in Cell Address B5..

Can any body give me a clue or suggestions please.

TIA

Rashid

Rename Multiple Sheets from a List of Available Names
 

Hmmm. You go from 01 to 050??? How about 01 to 50 (just two digits???).

If that's not ok, when do the names change from two to 3 digits?

If it is ok, then how about this macro:

Option Explicit
Sub testme()

Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet
Dim iCtr As Long
Dim wksName As String

iCtr = 0
With Worksheets("Index") '<-- worksheet with list of names.
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
For Each myCell In myRng.Cells
iCtr = iCtr + 1
wksName = Format(iCtr, "00")
If WorksheetExists(wksName, ThisWorkbook) = False Then
MsgBox "Worksheet named: " & wksName _
& " doesn't exist!" & vbLf & myCell.Value & " not added!"
Else
Worksheets(wksName).Range("b5").Value = myCell.Value
On Error Resume Next
Worksheets(wksName).Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Couldn't rename: " & _
wksName & " to " & myCell.Value
Err.Clear
End If
On Error GoTo 0
End If
Next myCell
End With

End Sub

Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
End Function

That second procedure (worksheetexists) was stolen from Chip Pearson.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

prkhan56 wrote:

Hello Experts,

I am using Windows XP/Office 2003 and have the following problem:

I have a Time Sheet Workbook with several sheets starting from 01 to
050.. (the number of sheets will vary)

In this workbook I have a Sheet Name Employees as follows

Column A
Row 1 Name
Row 2 Mr. A
Row 3 Mr. B
Row 4 Mr. C
..
..

etc etc

I wish to achieve the following through a macro

1) Rename each Sheet viz 01, 02. ..till end with the First Name from
Employees Sheet eg. 01 becomes Mr. A, 02 becomes Mr. B.. and so on till
the last employees name.

2) And copy Name of Employees in Address B5 .. means the respective
sheet name will also be shown in Cell Address B5..

Can any body give me a clue or suggestions please.

TIA

Rashid

--

Dave Peterson

Rename Multiple Sheets from a List of Available Names
 

Hi,

Sub Ren()
Dim S As Worksheet
Dim NewName As String
For Each S In ThisWorkbook.Worksheets
If IsNumeric(S.Name) = True Then
NewName = Sheets("sheet1").Range("A" & S.Name)
S.Range("B5").Value = NewName
S.Name = NewName

End If
Next


End Sub

Regards,
ste

Rename Multiple Sheets from a List of Available Names
 

Hello Dave,
Thanks a Million for your help.. Your macro works great .. I tested
upto 101 sheets..FYI sheets name would be 01 .. 10.. 11.. 101.. and not
050..
Thanks once again

Rashid

Dave Peterson wrote:
Hmmm. You go from 01 to 050??? How about 01 to 50 (just two
digits???).

If that's not ok, when do the names change from two to 3 digits?

If it is ok, then how about this macro:

Option Explicit
Sub testme()

Dim myCell As Range
Dim myRng As Range
Dim wks As Worksheet
Dim iCtr As Long
Dim wksName As String

iCtr = 0
With Worksheets("Index") '<-- worksheet with list of names.
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
For Each myCell In myRng.Cells
iCtr = iCtr + 1
wksName = Format(iCtr, "00")
If WorksheetExists(wksName, ThisWorkbook) = False Then
MsgBox "Worksheet named: " & wksName _
& " doesn't exist!" & vbLf & myCell.Value & " not
added!"
Else
Worksheets(wksName).Range("b5").Value = myCell.Value
On Error Resume Next
Worksheets(wksName).Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Couldn't rename: " & _
wksName & " to " & myCell.Value
Err.Clear
End If
On Error GoTo 0
End If
Next myCell
End With

End Sub

Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
End Function

That second procedure (worksheetexists) was stolen from Chip Pearson.

If you're new to macros, you may want to read David McRitchie's intro
at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

prkhan56 wrote:

Hello Experts,

I am using Windows XP/Office 2003 and have the following problem:

I have a Time Sheet Workbook with several sheets starting from 01
to
050.. (the number of sheets will vary)

In this workbook I have a Sheet Name Employees as follows

Column A
Row 1 Name
Row 2 Mr. A
Row 3 Mr. B
Row 4 Mr. C
..
..

etc etc

I wish to achieve the following through a macro

1) Rename each Sheet viz 01, 02. ..till end with the First Name
from
Employees Sheet eg. 01 becomes Mr. A, 02 becomes Mr. B.. and so on
till
the last employees name.

2) And copy Name of Employees in Address B5 .. means the respective
sheet name will also be shown in Cell Address B5..

Can any body give me a clue or suggestions please.

TIA

Rashid

--

Dave Peterson

Rename Multiple Sheets from a List of Available Names
 

Hello Ste,
Your macro does not do anything.. However the suggestion from Dave
works fine for me.

Thanks for your time

Rashid

Rename Multiple Sheets from a List of Available Names
 

I'm sorry for that Rashid.
I just tested the macro and it works...
anyway tanks for your reply.

bye!