#1
|
|||
|
|||
Create Tabs Days Of Month w/Copy Paste Template and Open To Current Date
This is what I'm working with. Isn't copying/pasting the TEMPLATE sheet and doesn't have code to open to current date. Anyone assist ? Code:
Sub ANIMATE_SUPLOG() Application.ScreenUpdating = False Dim Mth As Long, dy As Long, DaysInMonth As Long, yr As String, srcWS As Worksheet Set srcWS = ThisWorkbook.Sheets("Template") 'Name of worksheet that will be compiled to new workbook askyear: yr = InputBox("Enter the Year number required" _ & vbCrLf & "in the format of YYYY e.g. " & "2023" _ & vbCrLf & "" _ , "Enter Year Number") If yr = "" Or Val(yr) = 0 Then Exit Sub If Val(yr) < 1999 Or Val(yr) > 2100 Then GoTo askyear End If For Mth = 1 To 12 DaysInMonth = DateSerial(yr, Mth + 1, 1) - DateSerial(yr, Mth, 1) srcWS.Copy For dy = 1 To DaysInMonth Sheets(1).Copy After:=Sheets(Sheets.Count) With ActiveSheet .Name = Format(DateSerial(yr, Mth, dy), "dd MMM yy") .Range("H2") = Format(DateSerial(yr, Mth, dy), "dd MMMM yyyy") End With Next dy Application.DisplayAlerts = False Sheets(1).Delete Application.DisplayAlerts = True With ActiveWorkbook .SaveAs ThisWorkbook.Path & Application.PathSeparator & "Sup Log " & Format(Mth, "00") & " " & MonthName(Mth) & " " & yr & ".xlsx", FileFormat:=51 .Close False End With Next Mth Application.ScreenUpdating = True End Sub |
#2
|
|||
|
|||
Here is a a different macro that functions more to my liking :
Code:
Option Explicit Sub CreateSheets() Dim strDate As String Dim NumDays As Long Dim i As Long Dim sh As Object Dim wsBase As Worksheet On Error GoTo EndIt ' The Do statement to captures Month/Year via Input Box ' and return number of days in the month to the NumDays variable Do strDate = Application.InputBox( _ Prompt:="Please enter month and year: mm/yyyy", _ Title:="Month and Year", _ Default:=Format(Date, "mm/yyyy"), _ Type:=2) If strDate = "False" Then Exit Sub If IsDate(strDate) Then Exit Do If MsgBox("Please enter a valid date, such as ""01/2010""." _ & vbLf & vbLf & "Shall we try again?", vbYesNo + vbExclamation, _ "Invalid Date") = vbNo Then End Loop Application.ScreenUpdating = False NumDays = Day(DateSerial(Year(strDate), Month(strDate) + 1, 0)) Set wsBase = Sheets("Template") ' For each day, the For statement below copies the template sheet 'n' times For i = 1 To NumDays wsBase.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Format(DateSerial(Year(strDate), Month(strDate), i), "ddd mmm dd") Next i EndIt: Application.ScreenUpdating = True End Sub I've been trying to get the workbook to open to the current date/tab using the following (without success) : Code:
Private Sub Workbook_Open() Dim Today As Date Dim sh As Worksheet Dim MyVal As Variant Dim strDate As Variant Dim i As Long Dim NumDays As Variant MyVal = Format(DateSerial(Year(strDate), Month(strDate), i), "ddd mmm dd") For Each sh In ThisWorkbook.Worksheets For i = 1 To NumDays If sh.Name = MyVal(Today) Then sh.Select End If Next Next End Sub |
#3
|
||||
|
||||
try:
Code:
Private Sub Workbook_Open() Dim MyVal, sh MyVal = Format(Date, "ddd mmm dd") For Each sh In ThisWorkbook.Worksheets If sh.Name = MyVal Then sh.Select Next End Sub Code:
Private Sub Workbook_Open() On Error Resume Next Sheets(Format(Date, "ddd mmm dd")).Select End Sub |
#4
|
|||
|
|||
Thank you p45cal.
Its always the simple / less complicated things that get the job done. Kudos ! |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Field Code to Display Specific Date of Current or Next Month | lewis255 | Word | 1 | 03-07-2023 06:13 PM |
How to set date picker pop-up calendar to current month? | lafemmePJ | Word | 4 | 02-10-2023 08:26 AM |
If date is Current Month 1 or within 30 days | Sje | Excel | 3 | 09-30-2019 10:40 PM |
Date Field to add 10 Days to Current Date | Erbwon | Word | 6 | 11-12-2012 06:17 PM |
Create Multiple Tabs from Template | TeePee | Excel | 0 | 04-30-2009 11:54 AM |