macro for new monthy worksheet ?

Lukael

New member
Joined
Feb 9, 2014
Messages
21
Reaction score
0
Points
0
Hi,

I have a worksheet for monthly working schedule.I would like to create macro for a Cmdbutton, which would automatically jump on new sheet and add whole worksheet(table), with all formulas, so that copy/paste for new worksheet wouldn't be needed. Sheets should be named after next months.

I have found some similar examples on forums, but usually they only create new sheet without tables. My table should also be needed to adjust It's cell length, according to number of days in month, which are ofcourse not allways same.

Can this be done in VBA, Excel 2003 ?
 
yes, thanks, that was my thread & now It's solved
 
instead of crossposting you could attach here the file with explanations
 
Yes, sure, no problem, here It is :

Code:
Sub DoMonths()
    Dim J As Integer
    Dim K As Integer
    Dim sMo(12) As String


    sMo(1) = "January"
    sMo(2) = "February"
    sMo(3) = "March"
    sMo(4) = "April"
    sMo(5) = "May"
    sMo(6) = "June"
    sMo(7) = "July"
    sMo(8) = "August"
    sMo(9) = "September"
    sMo(10) = "October"
    sMo(11) = "November"
    sMo(12) = "December"
    
    Application.ScreenUpdating = False
    For J = 1 To 12
      Sheets(1).Copy after:=Sheets(Sheets.Count)
      With ActiveSheet
        .Name = sMo(J) & " " & Year(Date)
        For K = 1 To Day(DateSerial(Year(Date), J + 1, 0))
          .Cells(1, K).Value = DateSerial(Year(Date), J, K)
        Next K
        .Range(.Cells(1, K), .Cells(1, Columns.Count)).EntireColumn.Delete
        For K = .Shapes.Count To 1 Step -1
           If UCase(Left(.Shapes(K).Name, 3)) <> "OBJ" Then
              .Shapes(K).Delete
           End If
        Next K
      End With
    Next J
    Application.ScreenUpdating = True


    Sheets(1).Activate
End Sub

This code for macro executes on CmdButton (or any desired shape) to add new sheets which are named by months in the year. It adds days in the months too (starting in A1 cell to the end of the row), for the current year. Existing sheets (normally sheet 1-3) are left intact. When new sheets, named after month are inserted all shapes are deleted (such as CmdButton). Code also deletes every columns after the end of days, correspoding to month !

A few advice of changing code for your purposes :

If you want all sheets to be automatically changed for month sequence (no sheets 1-3 left), insert into code - right after defining variables:

Code:
Sheets(1).Name = sMo(1)
- you can do that also for sMo(2),sMo(3)...

If you don't want to delete column after the end of days, simply delete or put comment (') on these commands :
Code:
.Range(.Cells(1, K), .Cells(1, Columns.Count)).EntireColumn.Delete

If you have worksheet where your dates not start in A1, you can add this code and apply changes which fits your needs:

Code:
 .Cells(2, 4 + K).Value = DateSerial(Year(Date), J, K)
- this is example for Row 2, and Column 5 (E2 cell)


If you want to delete only certain shapes (or buttons, activeX), change your code with name of object:

Code:
If UCase(Left(.Shapes(K).Name, 3)) <> "CMD" Then
- This example deletes shapes with "CMD" name in it !

And finally, If you want to clear contents of copied sheet in all new month sheets :
Code:
Sub ClearContents()
Dim lngCounter As Long
For lngCounter = 2 To 12
  Sheets(lngCounter).Range("B2:AE2").ClearContents                 - adjust your desired range and try It (haven't done It myself so far, I hope It works) 
Next lngCounter
End Sub
 
Sorry, my mistake, If you want to change all existing sheets with months (sheet 1-3), you have to do this code, and then adjust It to your needs:

Code:
Sub DoMonths()
    Dim J As Integer
    Dim K As Integer
    Dim sMo(12) As String


    sMo(1) = "January"
    sMo(2) = "February"
    sMo(3) = "March"
    sMo(4) = "April"
    sMo(5) = "May"
    sMo(6) = "June"
    sMo(7) = "July"
    sMo(8) = "August"
    sMo(9) = "September"
    sMo(10) = "October"
    sMo(11) = "November"
    sMo(12) = "December"
    Sheets(1).Name = sMo(1)
    Application.DisplayAlerts = False
    For J = Sheets.Count To 2 Step -1
      Sheets(J).Delete
    Next
    Application.DisplayAlerts = True
    For J = 2 To 12
      Sheets(1).Copy after:=Sheets(Sheets.Count)
      Sheets(J).Name = sMo(J)
    Next


    Sheets(1).Activate
End Sub
 
Last edited:
Back
Top