Hi, I recently discovered that the code below will not create new months for 2009. Can you help?


Thanks.



Sub AtCurrentMonthCreateNextMonth()
Dim i As Long

With ActiveWorkbook
For i = 1 To 31
'based on current month, creates and names new worksheets for each day of the Next month
'also adds date to each form for every shift
'e.g. in Feb, Apr
If Month(DateSerial(Year(Date), (Month(Date) + 1), i)) <> (Month(Date) + 1) Then
Exit For
Else
.Worksheets(1).Copy After:=.Worksheets(.Worksheets.Count)
.ActiveSheet.Name = Format((DateSerial(Year(Date), (Month(Date) + 1), i)), "mmm d")
Range("J1")(1) = Format((DateSerial(Year(Date), (Month(Date) + 1), i)), "mm/dd/yyyy")
Range("J33")(1) = Format((DateSerial(Year(Date), (Month(Date) + 1), i)), "mm/dd/yyyy")
Range("J66")(1) = Format((DateSerial(Year(Date), (Month(Date) + 1), i)), "mm/dd/yyyy")
End If
Next i
End With
End Sub