Sub createsheets()
Dim dt as Date
Dim dt1 as Date
Dim lngMonth as Long, i as Long
If MsgBox( "Are you very very sure you want to do
this?", vbYesNo, "Create LOTS of Sheets") = vbYes Then
lngMonth = Application.InputBox("Enter a month number from" & _
" 1 to 12 Inclusive",type:=1)
if lngMonth < 1 or lngMonth 12 then exit sub
dt = DateSerial(Year(date),lngMonth+1,0)
dt1 = DateSerial(Year(date),lngMonth,0)
For i = 1 To Day(dt)
Sheets("Sheet1").Copy Befo=Worksheet _
(Worksheets.Count)
ActiveSheet.Name = i
Range("F3").Value = dt1 + i
Next
End If
End Sub

This assumes you will always create for a month in the current year.

--
Regards,
Tom Ogilvy



"hume" wrote in message
...

Hi,
The following code are run and creat many sheets
depand on the how many days of the current month. But
instead of just ONLY creat the current month, I would like
to have an option with the message box to ask me which
month that I like to creat the form. Then it will creat
the sheets according to the input date I provide. How do I
do that?

Sub createsheets()
If MsgBox( "Are you very very sure you want to do
this?", vbYesNo, "Create LOTS of Sheets") = vbYes Then
For i = 1 To Day(DateSerial(Year(Date),Month(Date
+ 1, 0))
Sheets("Sheet1").Copy Befo=Worksheet
(Worksheets.Count)
ActiveSheet.Name = i
Range("F3").Value = DateSerial(Year(Date), _
Month(Date) + 0, i)
Next
End If
End Sub