Copy to new WorkSheet and name as specific dates

[Pam in TX]

Am trying to do the following based on the answers to the beginning and ending date questions

• Create copies of the original sheet named "Master"
• Rename the tabs the correct dates and eliminate the weekends
• And if possible, put the date, ie name of tab, in cell K2

I can create the tabs and name the dates, but didn't copy the information from the original tab. Here is what I have so far. I appreciate your assistance.

Sub AddDatedWS()
Dim strStartDt As String
Dim strEndDt As String
Dim dtStart As Date
Dim dtEnd As Date
Dim wsNew As Worksheet
Dim n As Double
' Turns the screen off while the Macro is running.
Application.ScreenUpdating = False
'get start date
strStartDt = InputBox("Enter start date", "Create dated worksheets")
If Not IsDate(strStartDt) Then Exit Sub
'get end date
strEndDt = InputBox("Enter end date", "Create dated worksheets")
If Not IsDate(strStartDt) Then Exit Sub


'convert text to Excel's date format
dtStart = CDate(strStartDt)
dtEnd = CDate(strEndDt)
'test if start date equal to or later than end date
If dtStart >= dtEnd Then Exit Sub


'confirm number of sheets
If MsgBox("Create " & dtEnd - dtStart + 1 & " worksheets", vbOKCancel) = _
vbCancel Then Exit Sub


For n = dtStart To dtEnd
'create a new worksheet
Set wsNew = ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
'name it with a date (date text can't contain : \ / ? * [ or ])
wsNew.Name = Format(n, "mm.dd.yy")
Next n
'Turns the screen back on when the Macro is finished.
Application.ScreenUpdating = True
End Sub

[mdmackillop]

Sub AddDatedWS()
    Dim strStartDt As String
    Dim strEndDt As String
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim wsNew As Worksheet
    Dim n As Double
     ' Turns the screen off while the Macro is running.
    Application.ScreenUpdating = False
     'get start date
    strStartDt = InputBox("Enter start date", "Create dated worksheets")
    If Not IsDate(strStartDt) Then Exit Sub
     'get end date
    strEndDt = InputBox("Enter end date", "Create dated worksheets")
    If Not IsDate(strStartDt) Then Exit Sub
     
     
     'convert text to Excel's date format
    dtStart = CDate(strStartDt)
    dtEnd = CDate(strEndDt)
     'test if start date equal to or later than end date
    If dtStart >= dtEnd Then Exit Sub
     
     
     'confirm number of sheets
    If MsgBox("Create " & dtEnd - dtStart + 1 & " worksheets", vbOKCancel) = _
    vbCancel Then Exit Sub
     
     'Amended code @@@@@@@@@@@@@@@@@@@@@@ 
    For n = dtStart To dtEnd
        If Weekday(n) <> 1 And Weekday(n) <> 7 Then
         'create a new worksheet
        Set wsNew = ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
         'name it with a date (date text can't contain : \ / ? * [ or ])
        wsNew.Name = Format(n, "mm.dd.yy")
        Sheets("Master").UsedRange.Copy wsNew.Range("A1")
        wsNew.Range("K2") = Format(n, "mm.dd.yy")
        End If
    Next n
     'Turns the screen back on when the Macro is finished.
    Application.ScreenUpdating = True
End Sub

[Pam in TX]

This works great with a small complication. The new sheets that are created are not in the same format as the original. For instance, the columns are different widths than the original sheet so they have to be widened.

I have added a couple of lines to the macro, but am still not there yet.

Sub Add_Dates_of_Attendance()
Dim strStartDt As String
Dim strEndDt As String
Dim dtStart As Date
Dim dtEnd As Date
Dim wsNew As Worksheet
Dim n As Double
' Turns the screen off while the Macro is running.
Application.ScreenUpdating = False
'get start date
strStartDt = InputBox("Enter start date", "Create dated worksheets")
If Not IsDate(strStartDt) Then Exit Sub
'get end date
strEndDt = InputBox("Enter end date", "Create dated worksheets")
If Not IsDate(strStartDt) Then Exit Sub


'convert text to Excel's date format
dtStart = CDate(strStartDt)
dtEnd = CDate(strEndDt)
'test if start date equal to or later than end date
If dtStart >= dtEnd Then Exit Sub


'confirm number of sheets
If MsgBox("Create " & dtEnd - dtStart + 1 & " worksheets", vbOKCancel) = _
vbCancel Then Exit Sub

'Amended code @@@@@@@@@@@@@@@@@@@@@@
For n = dtStart To dtEnd
If Weekday(n) <> 1 And Weekday(n) <> 7 Then
'create a new worksheet
Set wsNew = ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
'name it with a date (date text can't contain : \ / ? * [ or ])
wsNew.Name = Format(n, "mm.dd.yy")
Sheets("Master").UsedRange.Copy wsNew.Range("A1")
wsNew.Range("K2") = Format(n, "mm.dd.yy")

ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 100
ActiveSheet.PageSetup.Orientation = xlLandscape

End If
Next n

'Turns the screen back on when the Macro is finished.
Application.ScreenUpdating = True
End Sub

[mdmackillop]

Save a blank hidden template sheet and make a copy of it to create your new sheets.

[Pam in TX]

Save a blank hidden template sheet and make a copy of it to create your new sheets.

Not sure how that helps....

PAM

[mdmackillop]

The blank sheet can be set up with your columns widths, headers, layout and any formatting you require.