VBA to rename sheet

[ANE0709]

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?

 

[ANE0709]

Without userform, try this macro:

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

is it possible to edit the code to give a 2 digit month and 2 digit day like 08.01.2022 instead of 8.1.2022? i have other elements in the workbook that sort the date numerically and i think mm.dd.yyyy format would be more helpful when sorting dates. i tried a few different mod's with no success.

 

[ANE0709]

Without userform, try this macro:

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

still no luck tying to convert the date format from m.d.yyyy to mm.dd.yyyy

 

[Akuini]

is it possible to edit the code to give a 2 digit month and 2 digit day like 08.01.2022 instead of 8.1.2022?

Try this:

Sub create_sheet()
Dim sht As Worksheet, sn As String
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
'                sn = y & "." & Format(x, "00") & "." & Format(n, "00") & "." ' format yyyy.mm.dd.
                sn = Format(x, "00") & "." & Format(n, "00") & "." & y & "."  'format mm.dd.yyyy.
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = sn & "MD"
                sht.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = sn & "FE"
            End If

Next
Application.ScreenUpdating = True

End Sub

i have other elements in the workbook that sort the date numerically and i think mm.dd.yyyy format would be more helpful when sorting dates

if sorting is the issue then yyyy.mm.dd. would be better, so use :

 sn = y & "." & Format(x, "00") & "." & Format(n, "00") & "." ' format yyyy.mm.dd.

 

[Akuini]

Sorry, the counter n is wrong.
It should be:

Sub create_sheet()
Dim sht As Worksheet, sn As String
Dim n As Long, y As Long, z 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
z = Format(WorksheetFunction.EoMonth(DateSerial(y, x, 1), "0"), "d")

For n = 1 To z

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

Next
Application.ScreenUpdating = True

End Sub

 

[ANE0709]

Sorry, the counter n is wrong.
It should be:

Sub create_sheet()
Dim sht As Worksheet, sn As String
Dim n As Long, y As Long, z 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
z = Format(WorksheetFunction.EoMonth(DateSerial(y, x, 1), "0"), "d")

For n = 1 To z

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

Next
Application.ScreenUpdating = True

End Sub

thought i responded. thank you. this worked out great

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.