How to split worksheet into multiple worksheets based on column content

Option Explicit

Sub ParseSiteData()
'JBeaucaire  (11/11/2009)
'Based on column A, data is filtered to individual sheets
'Creates sheets and sorts alphabetically in workbook
Dim LR As Long, i As Long, MyArr
Dim MyCount As Long, ws As Worksheet
Application.ScreenUpdating = False

Set ws = Sheets("Data")      'edit to sheet with master data
ws.Activate

Rows(1).Insert xlShiftDown
Range("A1") = "Key"
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("CC1"), Unique:=True
Columns("CC:CC").Sort Key1:=Range("CC2"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MyArr = Application.WorksheetFunction.Transpose(Range("CC2:CC" & Rows.Count).SpecialCells(xlCellTypeConstants))

Range("CC:CC").Clear
Range("A1").AutoFilter

For i = 1 To UBound(MyArr)
    ws.Range("A1").AutoFilter Field:=1, Criteria1:=MyArr(i)
    LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    If LR > 1 Then
        If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
        Else
            Sheets(MyArr(i)).Move After:=Sheets(Sheets.Count)
            Sheets(MyArr(i)).Cells.Clear
        End If
        ws.Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Sheets(MyArr(i)).Range("A1")
        ws.Range("A1").AutoFilter Field:=1
        MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
        Sheets(MyArr(i)).Columns.AutoFit
    End If
Next i

ws.Activate
ws.AutoFilterMode = False
LR = ws.Range("A" & Rows.Count).End(xlUp).Row - 1
Rows(1).Delete xlShiftUp
MsgBox "Rows with data: " & LR & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub