renaming sheets with numbers

[tuytuy]

Hi,
I have a workbook with 21 sheets, each sheet contains one section and the number of the section is in B1 for each sheet. It's under this format.

Section 1 Description of the section (variable number of character)

i was trying to rename each sheet with just the number of the section.
for example the name of the sheet that contains Section 1 would be "1". What i have so far renames the sheet with the word Section then the number.

'Rename each sheet


For Each ws In ActiveWorkbook.Worksheets
        ws.Name = Replace(Right(ws.Range("B1"), 2), " ", "_")
    Next ws

but i want to get rid of the section, this is to then arrange the sheets in ascending order.

 

[Dryver14]

Try this

Sub NameChange()
'Kevin Wilson MrExcel forum
Dim ws As Worksheet

Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        ws.Name = Right(Range("B1"), 1)
    Next ws
Application.ScreenUpdating = True
End Sub

 

[ZAX]

Here's The Code:

Sub RenameSheets()
For Sh = 1 To ActiveWorkbook.Sheets.Count
    For n = InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1 To Len(Sheets(Sh).Range("b1").Value)
        If IsNumeric(Mid$(Sheets(Sh).Range("b1").Value, n, 1)) = False Then
           i = n - 1
           Exit For
        End If
    Next
    Sheets(Sh).Name = Mid$(Sheets(Sh).Range("b1").Value, InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1, i - InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1)
Next
End Sub

ZAX

 

[tuytuy]

Here's The Code:

Sub RenameSheets()
For Sh = 1 To ActiveWorkbook.Sheets.Count
    For n = InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1 To Len(Sheets(Sh).Range("b1").Value)
        If IsNumeric(Mid$(Sheets(Sh).Range("b1").Value, n, 1)) = False Then
           i = n - 1
           Exit For
        End If
    Next
    Sheets(Sh).Name = Mid$(Sheets(Sh).Range("b1").Value, InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1, i - InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1)
Next
End Sub

ZAX

works fine, but after the number of the sheet you code adds a space, how can i get rid of this space ?

 

[ZAX]

I'm Sorry I didn't notice while trying the code.

Sub RenameSheets()
For Sh = 1 To ActiveWorkbook.Sheets.Count
    For n = InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1 To Len(Sheets(Sh).Range("b1").Value)
        If IsNumeric(Mid$(Sheets(Sh).Range("b1").Value, n, 1)) = False Then
           i = n - 1
           Exit For
        End If
    Next
    y = Mid$(Sheets(Sh).Range("b1").Value, InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1, i - InStr(1, Sheets(Sh).Range("b1").Value, " ") + 1)
    Sheets(Sh).Name = Left(y, Len(y) - 1)
Next
End Sub

ZAX

 

[tuytuy]

no worries thx for the help

 

[tuytuy]

you wouldn't know how to sort the sheets in ascending order by any chance ?
this is what i got but all it does is put all the sheets with which name starts by a 1 in front then put the other one in ascending order.
EG.
1, 10, 11, 2, 21, 22, 3, 4, 5, 6, 7, 8, 9

Dim i As Integer, j As Integer, h As Integer
h = Sheets.Count
On Error GoTo ErrorTrap:
For i = 1 To h - 1
    For j = i + 1 To h
        If Sheets(j).Name < Sheets(i).Name Then
        Sheets(j).Move Before:=Sheets(i)
        End If
    Next
    Next
ErrorTrap: