# Rename Multiple Tabs

#### Mulderman

##### Board Regular
Hi there

Could you help with an onerous task that I must complete every Quarter.

I have a spreadsheet with multiple tabs.

The first 3 Tabs are Calculation sheets and do not need to be re-named.

All the preceeding sheets each need to be renamed to the days of the month (British Format), skiping Sundays.

i.e Tab 4 should be renamed 010409, Tab 5 should be renamed 020409, Tab 6 should be renamed 030409, Tab 7 should be renamed 040409, Tab 8 should be renamed 060409 and Tab 9 should be renamed 070409 etc etc ...

Extra - Also if possible on each sheet could the Tab date be placed into Cell A4 (eg. 010409) and also the Day number (eg. 01) (Starting from 01 on 010409, 02 on 020409, 03 on 030409, 04 on 040409, 05 on 060409, 06 on 070409 etc etc ...) into Cell A6.

Many Thanks

Mulderman

### Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

#### PCL

##### Well-known Member
Perhaps
It's up to you to prepare the right number of sheets.
Code:
``````Option Explicit
Sub Sheet_Rename()
Dim I As Integer
Dim MonthNb As Variant
Dim MyString As String
Dim MyDay As String
On Error GoTo ENDSUB
MonthNb = Application.InputBox("Give a month Number")
MonthNb = MonthNb * 1
If ((MonthNb >= 1) And (MonthNb <= 12)) Then
If (MonthNb < 10) Then
MyString = "0" & MonthNb & "09"
Else
MyString = MonthNb & "09"
End If

For I = 4 To Sheets.Count
Sheets(I).Select
If (I < 14) Then
MyDay = "0" & I - 3
Else
MyDay = I - 3
End If
Sheets(I).Name = MyDay & MyString
Sheets(I).Range("A4") = MyDay & MyString
Sheets(I).Range("A6") = MyDay
Next I
End If
ENDSUB:
End Sub``````

#### Mulderman

##### Board Regular
Thanks for this PCL, its a great help !

Just a point to tinker with.

At present the code is not skipping Sundays. My workbook doesnt have any tabs for Sundays so I need the rename to skip any Sunday dates.

Any idea's ??

Cheers

Mulderman

#### PCL

##### Well-known Member
Yes I forgot completely the Sunday skip, here another try.
Code:
``````Option Explicit
Sub Sheet_Rename()
Dim I As Integer, J As Integer
Dim MonthNb As Variant
Dim MyString As String
Dim MyDay As String
Dim MyYEAR As String
Dim WeekDayTest As Integer
Dim WeekDayTest2 As Integer
Dim Date_Nb As Date
Dim Date_Nb2 As Date
MyYEAR = "2009"
On Error GoTo ENDSUB
MonthNb = Application.InputBox("Give a MONTH NUMBER")
MonthNb = MonthNb * 1                       '  TURN  TO  NUMBER IN CASE IT'S NOT  or MAKE AN ERROR

If ((MonthNb >= 1) And (MonthNb <= 12)) Then
If (MonthNb < 10) Then                  '  PREPARE MONTH WITH 2 CHARACTERS
MyString = "0" & MonthNb & Right(MyYEAR, 2)
Else
MyString = MonthNb & Right(MyYEAR, 2)
End If
J = 1
For I = 4 To Sheets.Count
Sheets(I).Select
'-------    DETERMINE  WEEKDAY
Date_Nb = MonthNb & "/" & J & "/" & MyYEAR         '  DATE  FOR  EXCEL
Date_Nb2 = J & "/" & MonthNb & "/" & MyYEAR        '  DATE  FOR  EXCEL
WeekDayTest = WorksheetFunction.Weekday(Date_Nb * 1, 2)
WeekDayTest2 = WorksheetFunction.Weekday(Date_Nb2 * 1, 2)

If (WeekDayTest = 7) Then J = J + 1         '  IT  WAS A  SUNDAY
If (J < 14) Then
MyDay = "0" & J                  '  PREPARE DAY WITH 2 CHARACTERS
Else
MyDay = J
End If

Sheets(I).Name = MyDay & MyString
Sheets(I).Range("A4") = MyDay & MyString
Sheets(I).Range("A6") = MyDay
J = J + 1
Next I
End If
ENDSUB:
End Sub``````

L

#### Legacy 68668

##### Guest

try
Code:
``````Sub test()
Dim i As Long, myDate As Date
myDate = DateSerial(Year(Date), Month(Date), 0)
For i = 3 To Sheets.Count
Do
Loop Until WeekDay(myDate) <> 1
With Sheets(i)
.Name = Format(myDate, "ddmmyy")
With .Range("a6")
.NumberFormat = "dd"
.Value = myDate
End With
End Wtih
Next
End Sub``````

#### Mulderman

##### Board Regular
Thanks Guys, both options allowed me to choose the best bits of code and alter it to fit my personal project.

You both saved me considerable manual work, so with that in mind, may I thank you both publically and privately for a job well done !

Cheers

Mulderman

#### PCL

##### Well-known Member
Using previous lesson (Thank you Seiya's code) here my new code.

Code:
``````Sub Sheet_Rename2()
Dim I As Integer, J As Integer
Dim MyMonth As Variant
Dim MyYEAR As String
Dim WeekDayTest As Integer
Dim myDate As Date
MyYEAR = "2009"
On Error GoTo ENDSUB
MyMonth = Application.InputBox("Give a MONTH NUMBER")
MyMonth = MyMonth * 1                         '  TURN  TO  NUMBER IN CASE IT'S NOT  or MAKE AN ERROR

If ((MyMonth >= 1) And (MyMonth <= 12)) Then
J = 1
For I = 4 To Sheets.Count
With Sheets(I)
myDate = DateSerial(MyYEAR, MyMonth, J)
WeekDayTest = Weekday(myDate, 2)
If (WeekDayTest = 7) Then J = J + 1         '  IT  WAS A  SUNDAY
.Name = Format(myDate, "ddmmyy")
.Range("A4").NumberFormat = "ddmmyy"
.Range("A4") = myDate
.Range("A6").NumberFormat = "dd"
.Range("A6") = J
J = J + 1
End With
Next I
End If
ENDSUB:
End Sub``````

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

1,164,279
Messages
5,836,366
Members
430,424
Latest member
ALHK022

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back