I have a vba code that I need help add or change code

I have yearly schedule. When you press button that will creating 1-17 worksheets. I need to have to create 1-18 worksheets. I need help with vba code to make code to work what I want.

Private Sub CREATING_WEEKLY_SCHEDULES_Click()
 Dim LastRow As Integer, rngUniqueWeeks As Range, rngWeeks As Range
    Application.ScreenUpdating = False
    With Worksheets("Yearly Schedule")
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & LastRow).AdvancedFilter xlFilterInPlace, Unique:=True
        Set rngUniqueWeeks = .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
        For Each rngWeeks In rngUniqueWeeks
            .Range("A1:A" & LastRow).AutoFilter 1, rngWeeks
            If Evaluate("ISREF('" & rngWeeks.Value & "'!A1)") Then  'Test if worksheet name exists
                'Copy to existing sheet
                .Range("A2:A" & LastRow).EntireRow.Copy _
                    Sheets(rngWeeks.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
            Else
                'Create Weeks sheet
                Sheets.Add(After:=Sheets(Sheets.Count)).Name = rngWeeks
                .AutoFilter.Range.EntireRow.Copy Destination:=ActiveSheet.Range("A1")
            End If
        Next rngWeeks
        .Select
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
    MsgBox "Copy complete. ", , "Split Records By Weeks"
End Sub