Rename Multiple Sheets - Help with Mr Dave Peterson's Code
 

Hello All,
I am using Office2003/Windows XP and Mr Dave Peterson helped with my
problem.. I need help to modify that macro


The following macro Renames Sheet according to the names in "Index"

I wish to change the following to include Column B also
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))

and to change the following to show the value in B1 downward in Cell M2
of each individual renamed Sheet

Worksheets(wksName).Range("b5").Value = myCell.Value

For example now the macro renames sheet for eg: Tom and then put the
Name Tom in B5. Now I have included the Emp No. in Column B of
'Index' and I wish to have the employee number in M2 on each
individual sheet

Can anybody help me....
Thanks in advance
And Wishing every one a Very Very Happy and Prosperous New Year

Rashid Khan

Option Explicit
Sub RenameSheet()
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

Rename Multiple Sheets - Help with Mr Dave Peterson's Code
 

This is the line that assigns the value in column A to B5:
Worksheets(wksName).Range("b5").Value = myCell.Value

Just add another (right under that line) that looks like:
Worksheets(wksName).Range("M2").Value = myCell.offset(0,1).Value

Or maybe even a few lines to preserve formatting:

with Worksheets(wksName).Range("m2")
.Value = myCell.offset(0,1).Value
.numberformat = "000000"
end with

(Change that format to what you need.)



wrote:

Hello All,
I am using Office2003/Windows XP and Mr Dave Peterson helped with my
problem.. I need help to modify that macro

The following macro Renames Sheet according to the names in "Index"

I wish to change the following to include Column B also
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))

and to change the following to show the value in B1 downward in Cell M2
of each individual renamed Sheet

Worksheets(wksName).Range("b5").Value = myCell.Value

For example now the macro renames sheet for eg: Tom and then put the
Name Tom in B5. Now I have included the Emp No. in Column B of
'Index' and I wish to have the employee number in M2 on each
individual sheet

Can anybody help me....
Thanks in advance
And Wishing every one a Very Very Happy and Prosperous New Year

Rashid Khan

Option Explicit
Sub RenameSheet()
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

--

Dave Peterson

Rename Multiple Sheets - Help with Mr Dave Peterson's Code
 

Thanks Dave,

As usual you are a great help.
Works like a charm

Rashid