Macro to add month sheets containing days

[Retroshift]

Hi,

I have a VBA code (see below) for a macro button to add month sheets in a workbook.
Now the month sheets are sorted from January to December, but I would like them to be sorted from December to January; while still keeping differently named sheets at the end of the worksheet tabs.

After hitting the macro button, I would like to make an inputbox appear which asks to put a year (starting from the current year, so not earlier than the current year; and only 4 digits are allowed).
And the first row of each month sheet should be populated with all the days (date) of the month in this sheetname, of the year that was entered into the inputbox.

The macro button can only be used once per workbook, unless you manually copy the workbook (for a new year). The code should recognize that the copied workbook is a copy of the original workbook, so the button now can be used again, and the copied month sheets can be overwritten.

Anyone has the VBA knowledge to alter this code accordingly?

Sub AddMonthSheets()
Dim i As Integer
Dim j As Integer

For i = 1 To 12
    If i <= Sheets.Count Then
        If Left(Sheets(i).Name, 5) = "Sheet" Then
            Sheets(i).Name = MonthName(i)
        Else
            Sheets.Add.Move after:=Sheets(Sheets.Count)
            ActiveSheet.Name = MonthName(i)
        End If
    Else
        Sheets.Add.Move after:=Sheets(Sheets.Count)
        ActiveSheet.Name = MonthName(i)
    End If
Next i

For i = 1 To 12
    If Sheets(i).Name <> MonthName(i) Then
        For j = i + 1 To Sheets.Count
            If Sheets(j).Name = MonthName(i) Then
                Sheets(j).Move Before:=Sheets(i)
            End If
        Next j
    End If
Next i

Sheets(1).Activate

End Sub

 

[davesexcel]

You can start at 12 and work down as well.

Sub Button1_Click()
    Dim yr As String
    Dim i As Integer
    Dim j As Integer

    yr = InputBox("What year?")
    For i = 12 To 1 Step -1
        If i <= Sheets.Count Then
            If Left(Sheets(i).Name, 5) = "Sheet" Then
                Sheets(i).Name = MonthName(i)
            Else
                Sheets.Add.Move after:=Sheets(Sheets.Count)
                With ActiveSheet
                .Name = MonthName(i)
                .Range("A1") = DateSerial(yr, i, 1)
                .Range("A1").NumberFormat = "mmmm dd, yyyy"
                .Range("A1").autofill Destination:=Range("A1:AE1"), Type:=xlFillDefault
                .Range("A1:AE1").Value = .Range("A1:AE1").Value
                .Range("A1:AE1").Columns.AutoFit
                End With
            End If
        Else
            Sheets.Add.Move after:=Sheets(Sheets.Count)
            With ActiveSheet
                .Name = MonthName(i)
                .Range("A1") = DateSerial(yr, i, 1)
                .Range("A1").NumberFormat = "mmmm dd, yyyy"
                .Range("A1").autofill Destination:=Range("A1:AE1"), Type:=xlFillDefault
                .Range("A1:AE1").Value = .Range("A1:AE1").Value
                .Range("A1:AE1").Columns.AutoFit
            End With
        End If
    Next i


    Sheets(1).Activate

End Sub

 

[Retroshift]

Thanks, Dave. This helps a long way already.

Three questions:
1) I want to populate the dates starting from column B instead of A, so I changed the A's to B's. But how do I avoid populating the dates all the way to cell BE1, which adds unexisting days to that month?
2) How can I highlight the columns of the weekend days in blue?
3) I added criteria to the input box with the additional code below. But how do I avoid still getting the message box after cancelling the input box?

Do
    yr = InputBox("For which year you want to create month sheets?", "Year", "e.g. " & Year(Date))
      Select Case True
        Case yr Like "[2-9][0-9][0-9][0-9]"
        Case Else
        MsgBox ("Enter a year value later than the year 1999")
      End Select
      If StrPtr(yr) = 0 Then Exit Sub
    Exit Do
    Loop