Sub SplitWBK()
Dim Rng As Range, c As Range, List As New Collection, Item As Variant, ShNew As Worksheet
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("AU2", Cells(Rows.Count, "AU").End(3))
On Error Resume Next
For Each c In Rng
List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set Rng = ActiveSheet.Range("A1:GY" & ActiveSheet.Range("C165536").End(3).Row)
For Each Item In List
Set ShNew = Worksheets.Add: ShNew.Name = Left(Trim(Item), 15)
Rng.AutoFilter 47, Item: Rng.SpecialCells(12).Copy ShNew.Range("A1"): Rng.AutoFilter
Next Item
End Sub