从本月的特定日期到下个月的特定日期创建Excel VBA工作表

Question

I am creating sheets from the 20th of the month till the 19th of the next month. Why wouldn't the following code run?

Dim sDate As Date, nDate As Date

sDate = DateSerial(Year(Date), Month(Date), 20)

nDate = DateSerial(Year(Date), Month(Date) + 1, 19)

For k = sDate To nDate     'DaysInMonth
       'copy template sheet
        wbkCur.Worksheets("Template").Copy After:=Sheets(wbkCur.Worksheets.Count)
        Select Case k
            Case 1, 21, 31
                TabName = "st"
            Case 2, 22
                TabName = "nd"
            Case 3, 23
                TabName = "rd"
            Case Else
                TabName = "th"
        End Select
        'rename to Day of Month
        ActiveSheet.Name = ShortName & " " & k & TabName
next k

Answer 1

Try this:

Option Explicit

Sub dural()
    Dim wbkCur As Workbook, ws As Worksheet
    Dim sDate As Date, nDate As Date
    Dim i As Integer
    Dim k As Date
    Dim TabName As String, ShortName As String

    sDate = DateSerial(Year(Date), Month(Date), 20)
    nDate = DateSerial(Year(Date), Month(Date) + 1, 19)

    Set wbkCur = ThisWorkbook

    For k = sDate To nDate
         i = Day(k)

         wbkCur.Worksheets("Template").Visible = xlSheetVisible
         wbkCur.Worksheets("Template").Copy After:=wbkCur.Sheets(wbkCur.Worksheets.Count)
         Set ws = ActiveSheet

         Select Case i
             Case 1, 21, 31: TabName = i & "st"
             Case 2, 22: TabName = i & "nd"
             Case 3, 23: TabName = i & "rd"
             Case Else: TabName = i & "th"
         End Select

         '~~> 23rd_1_2015. The earlier replace was creating 7_20_2015th
         TabName = ShortName & " " & TabName & "_" & Month(k) & "_" & Year(k)
         '~~> For m_dd(th)_2015, uncomment the below
         'TabName = ShortName & " " & Month(k) & "_" & TabName & "_" & Year(k)

         '~~> Delete any sheet with the existing name else
         '~~> Renaming sheet to an existing name will give an error
         On Error Resume Next
         Application.DisplayAlerts = False
         wbkCur.Sheets(TabName).Delete
         Application.DisplayAlerts = True
         On Error GoTo 0

         ws.Name = TabName
    Next k
End Sub