Sep 10 2021 06:09 PM - edited Sep 10 2021 06:14 PM
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
Sep 10 2021 08:00 PM