VBA to rename sheet

ANE0709

Board Regular
Joined
Feb 2, 2022
Messages
65
Office Version
  1. 365
Platform
  1. Windows
Is there a way to have VBA copy a current sheet and custom rename it?

Currently we have a workbook where we create 2 new tabs for each day of the month 7.10.22 MD, 7.10.22 FE, 7.11.22 MD, 7.11.22 FE, etc. (Monday - Saturday, no Sunday dates). i would like if possible to automate this. Is this possible?

1657634927877.png
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Try this:
VBA Code:
Sub Make_Copies_Of_Sheet()
'Modified  7/13/2022  9:17:29 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim x As Long
x = 0
Dim ans As Long
Dim y As String
y = Format(Date, "YYYY")

ans = InputBox("Enter Month Number", "April", 4)

  Select Case ans
   Case 9, 4, 6, 11: x = 30
         For i = 1 To x
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "MD"
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "FE"
        Next
    
    
Case 1, 3, 5, 7, 8, 10, 12: x = 31
     For i = 1 To x
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "MD"
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "FE"
        Next
   
   Case 2: x = 29
        
         For i = 1 To x
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "MD"
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "FE"
        Next
  End Select

Application.ScreenUpdating = True
End Sub
 
Upvote 0
Or try this:
The Inputbox pops up with Current month as the Month you want new sheets for.
You can always enter a different month if you want.
VBA Code:
Sub Make_Copies_Of_Sheet()
'Modified  7/13/2022  9:30:52 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim x As Long
x = 0
Dim ans As Long
Dim y As String
y = Format(Date, "YYYY")
Dim M As String
M = Format(Date, "MMMM")
Dim D As String
D = Format(Date, "M")

ans = InputBox("Enter Month Number", M, D)

  Select Case ans
   Case 9, 4, 6, 11: x = 30
         For i = 1 To x
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "MD"
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "FE"
        Next
    
    
Case 1, 3, 5, 7, 8, 10, 12: x = 31
     For i = 1 To x
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "MD"
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "FE"
        Next
   
   Case 2: x = 29
        
         For i = 1 To x
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "MD"
            Sheets("TEMPLATE").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = ans & "." & i & "." & y & "." & "FE"
        Next
  End Select

Application.ScreenUpdating = True
End Sub
 
Upvote 0
@ANE0709
Another option:
I'm using a userform, you can choose month & year from 2 comboboxes.
It create 2 new tabs for each day of the month 7.10.22 MD, 7.10.22 FE, 7.11.22 MD, 7.11.22 FE, etc. (Monday - Saturday, no Sunday dates).

ANE0709.jpg


the file:
 
Upvote 0
If in the combobox you want to show month number instead of month name then replace the code in the userform (in the file in post #15) with this one:
VBA Code:
Option Explicit

Private Sub UserForm_Initialize()
Dim n As Long
For n = 1 To 12
    ComboBox1.AddItem n
Next

For n = 2022 To 2030
    ComboBox2.AddItem n
Next
CommandButton1.Caption = "CREATE SHEETS"

End Sub

Private Sub CommandButton1_Click()

Dim sht As Worksheet
Dim x As Long, n As Long, y As String
Application.ScreenUpdating = False

'Set sht = ActiveSheet
Set sht = Sheets("TEMPLATE")
x = ComboBox1.Value
y = Right(ComboBox2.Value, 2)

'get last day of the month
n = Format(WorksheetFunction.EoMonth(DateSerial(CLng(ComboBox2.Value), x, 1), "0"), "d")

For n = 1 To n

            If Weekday(DateSerial(CLng(ComboBox2.Value), x, n)) <> 1 Then  'exclude Sunday
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = x & "." & n & "." & y & "." & "MD"
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = x & "." & n & "." & y & "." & "FE"
            End If

Next
Application.ScreenUpdating = True

End Sub
 
Upvote 0
@MyAswerIsThis both of those worked, it created all the tabs and i tested it with several months. Is there a way to factor in not creating the tabs if the date is a sunday?

@Akuini unfortunatly i couldnt test yours. My IT restrictions do not allow me to open the link you provided. i did try to copy/paste the code you provided but without the command object it will not run and i do not actually have any experience with userforms.
 
Upvote 0
@Akuini unfortunatly i couldnt test yours. My IT restrictions do not allow me to open the link you provided. i did try to copy/paste the code you provided but without the command object it will not run and i do not actually have any experience with userforms.

Without userform, try this macro:
VBA Code:
Sub create_sheet()
Dim sht As Worksheet
Dim n As Long, y As Long, x
Application.ScreenUpdating = False

'Set sht = ActiveSheet
Set sht = Sheets("TEMPLATE")
y = 2022 'year

    x = Application.InputBox("Insert month number:", Type:=2)
   
    If x < 0 Or x > 12 Or Not IsNumeric(x) Or x = False Then
            MsgBox "Wrong entry"
            Exit Sub
    End If

'get last day of the month
n = Format(WorksheetFunction.EoMonth(DateSerial(y, x, 1), "0"), "d")

For n = 1 To n

            If Weekday(DateSerial(y, x, n)) <> 1 Then  'exclude Sunday
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = x & "." & n & "." & y & "." & "MD"
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = x & "." & n & "." & y & "." & "FE"
            End If

Next
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Without userform, try this macro:
VBA Code:
Sub create_sheet()
Dim sht As Worksheet
Dim n As Long, y As Long, x
Application.ScreenUpdating = False

'Set sht = ActiveSheet
Set sht = Sheets("TEMPLATE")
y = 2022 'year

    x = Application.InputBox("Insert month number:", Type:=2)
  
    If x < 0 Or x > 12 Or Not IsNumeric(x) Or x = False Then
            MsgBox "Wrong entry"
            Exit Sub
    End If

'get last day of the month
n = Format(WorksheetFunction.EoMonth(DateSerial(y, x, 1), "0"), "d")

For n = 1 To n

            If Weekday(DateSerial(y, x, n)) <> 1 Then  'exclude Sunday
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = x & "." & n & "." & y & "." & "MD"
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = x & "." & n & "." & y & "." & "FE"
            End If

Next
Application.ScreenUpdating = True

End Sub
this worked beautifully :) I am going to make a new post regarding this same project (i think forum rules require me to). i have a code i need to modify to list the tab names.

@Akuini and @My Aswer Is This Thank you for all your help getting this together :)
 
Upvote 0
@MyAswerIsThis both of those worked, it created all the tabs and i tested it with several months. Is there a way to factor in not creating the tabs if the date is a sunday?

@Akuini unfortunatly i couldnt test yours. My IT restrictions do not allow me to open the link you provided. i did try to copy/paste the code you provided but without the command object it will not run and i do not actually have any experience with userforms.
Well, that may be possible, but I see your getting answers now from other users. And marking those answers as solved. I did a lot of work writing my script then others provide different ways so I guess I should move on and help others who have no answers to their questions. At least I attracted others to help you. Take care
 
Upvote 0

Forum statistics

Threads
1,215,206
Messages
6,123,638
Members
449,109
Latest member
Sebas8956

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top