How do I copy a worksheet for each day of the year?
This is the code I am using, I just can't figure out how to get the new
worksheets to be the same as the first worksheet:
Sub CreateWorksheetsByDate()
Dim myDate As Variant
Dim iCtr As Long
Dim myStr As String
Dim testwks As Worksheet
Dim SH As Worksheet
Set SH = ActiveSheet
myDate = InputBox(Prompt:="Enter the first day of the Month you want to
Create", _
Default:=Format(Date, "mm/dd/yy"))
'Default:=Format(Date, "mmmm dd, yyyy"))
If IsDate(myDate) = False Then
MsgBox "Please try later"
Exit Sub
End If
Application.ScreenUpdating = False
myDate = CDate(myDate)
For iCtr = DateSerial(Year(myDate), Month(myDate), 1) _
To DateSerial(Year(myDate), Month(myDate) + 1, 0)
Select Case Weekday(iCtr)
'Case Is = vbSunday, vbSaturday (Does all days, remove ' does
only weekdays)
'do nothing
Case Else
'myStr = Format(iCtr, "yyyy_mm_dd_dddd")
myStr = Format(iCtr, "dddd mm-dd")
Set testwks = Nothing
On Error Resume Next
Set testwks = Worksheets(myStr)
On Error GoTo 0
If testwks Is Nothing Then
Set testwks _
= Worksheets.Add(after:=Worksheets(Worksheets.Count) )
testwks.Name = myStr
End If
End Select
Next iCtr
Worksheets("Setup").Activate
Application.ScreenUpdating = True
End Sub
Thanks!
"Harald Staff" wrote:
Glad it worked for you Kay.
(Your boss will understand that a job like that would take at least 2-3 long
unpaid evenings, and buy you an expensive dinner :-)
Best wishes Harald
"Kaybay" skrev i melding
...
Hi Harold,
It's like magic!
Thank you very much. I really appreciate the help.
Kay
"Harald Staff" wrote:
Hi
Run this littme macro when your master sheet is the active sheet:
Sub MakeYear()
Dim SH As Worksheet
Dim D As Date, Y As Long
Set SH = ActiveSheet
Y = Val(InputBox("Year:"))
If Y < 2000 Then Exit Sub
If Y 2100 Then Exit Sub
Application.ScreenUpdating = False
For D = DateSerial(Y, 1, 1) To DateSerial(Y, 12, 31)
Application.StatusBar = D
SH.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Range("A1").Value = D
ActiveSheet.Name = Format(D, "mmm dd")
Next
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
HTH. best wishes Harald
"Kaybay" skrev i melding
...
I'm trying to create a new sheet for each day of the year. It needs
to
contain the day and date but I really don't want to copy and paste 2
years
of
forms and manually change the date. Please can anybody help.
|