Rename worksheets macro

[Harry Flashman]

I have a macro which allows me to create worksheets based on a table
(for example cells A1:A10), which creates the worksheets and orders
the worksheets as per the table,
I also have a macro, which allows me to sort the worksheet according
to the table. This means I can change the order in the table (which
contains the worksheet names), and then sort the worksheets
accordingly.
Here are the macros: (the second macro is the one I think can be
altered to do what I want).

Sub NewWorkSheets()
' before this macro is run make sure the first worksheet is named
"Table of Contents"
' this macro will insert new worksheets in the correct order
On Error Resume Next
Dim Arr As Variant
Dim i As Long
Dim NewSheet As Worksheet
Arr = Selection.Value
For i = LBound(Arr) To UBound(Arr)
Set NewSheet = Sheets.Add
NewSheet.Name = Arr(i, 1)
Next i
Sheets("Table of Contents").Select
Sheets("Table of Contents").Move Before:=Sheets(1)
'Sort worksheets based on table on worksheet 1
On Error Resume Next
Dim SortOrder As Variant
Dim Ndx As Long
With Selection
For Ndx = .Cells.Count To 1 Step -1
Worksheets(.Cells(Ndx).Value).Move after:=Worksheets(1)
Next Ndx
End With
Sheets("Table of Contents").Select

End Sub

Sub SortWorksheets()
'Sort worksheets based on table on worksheet 1
On Error Resume Next
Dim SortOrder As Variant
Dim Ndx As Long
With Selection
For Ndx = .Cells.Count To 1 Step -1
Worksheets(.Cells(Ndx).Value).Move after:=Worksheets(1)
Next Ndx
End With
Sheets("Table of Contents").Select
End Sub


I was hoping that someone might be able to alter the second macro so
that it will rename the worksheets according to a table rather than
sorting them.
In this case the worksheets names might be contained in the selection
A1:A10, and the new names in B1:B10
I am sure this is possible, and I tried to do this myself but I am not
very knowledgeable about VBA.
If anyone could help me I would greatly appreciate it.

Harry

 

[JBeaucaire]

How about one macro that does everything? Just setup your columns A and B
with as many sheet names as you want, it doesn't have to be just 10. The
"MATCHING/CREATING" is done by the values in column A. The "RENAMING" is done
by the values in column B.

========
Option Explicit

Sub ManageSheets()
'JBeaucaire (10/28/2009)
' make sure the names are in "Table of Contents"
' this macro will create/move/rename sheets as needed
Dim Rng As Range, cel As Range
Dim LR As Long, ws As Worksheet
Application.ScreenUpdating = False

Set ws = Sheets("Table of Contents")
ws.Activate
LR = Range("A" & Rows.Count).End(xlUp).Row

Set Rng = Range("A1:A" & LR)

For Each cel In Rng
If Not Evaluate("ISREF('" & cel & "'!A1)") Then
If cel.Offset(0, 1) = "" Then
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = cel
Else
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = cel.Offset(0,
1)
End If
ws.Activate
Else
Sheets(cel.Value).Move After:=Sheets(Sheets.Count)
If cel.Offset(0, 1) <> "" Then Sheets(cel.Value).Name =
cel.Offset(0, 1)
End If
Next cel

ws.Activate
Application.ScreenUpdating = True
End Sub
============

Does that help?

 

[Harry Flashman]

How about one macro that does everything?  Just setup your columns A and B
with as many sheet names as you want, it doesn't have to be just 10.  The
"MATCHING/CREATING" is done by the values in column A. The "RENAMING" is done
by the values in column B.

========
Option Explicit

Sub ManageSheets()
'JBeaucaire  (10/28/2009)
' make sure the names are in "Table of Contents"
' this macro will create/move/rename sheets as needed
Dim Rng As Range, cel As Range
Dim LR As Long, ws As Worksheet
Application.ScreenUpdating = False

Set ws = Sheets("Table of Contents")
ws.Activate
LR = Range("A" & Rows.Count).End(xlUp).Row

Set Rng = Range("A1:A" & LR)

For Each cel In Rng
    If Not Evaluate("ISREF('" & cel & "'!A1)") Then
        If cel.Offset(0, 1) = "" Then
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = cel
        Else
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = cel.Offset(0,
1)
        End If
        ws.Activate
    Else
        Sheets(cel.Value).Move After:=Sheets(Sheets.Count)
        If cel.Offset(0, 1) <> "" Then Sheets(cel.Value).Name =
cel.Offset(0, 1)
    End If
Next cel

ws.Activate
Application.ScreenUpdating = True
End Sub
============

Does that help?

--
"Actually, I *am* a rocket scientist." -- JB
(www.MadRocketScientist.com)

Your feedback is appreciated, click YES if this post helped you.










- Show quoted text -

Thanks very much for that. Your macro does indeed combine the tasks of
creating, sorting or renaming. Very clever.
Cheers