Advance Filter to copy to new sheets

Question

I'm am trying to automatically filter a column and copy/paste all the unique values to a new sheet each. Here's the code that I have been working with, however I'm facing this error when running the code:

Run-time error '1004': The extract range has a missing or invalid field name.

Sub Filter()

Application.ScreenUpdating = False

Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String

'specify sheet name in which the data is stored
sht = "Filter This"

'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "C").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:H" & last)

Sheets(sht).Range("C1:C" & last).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("AA1"), _
Unique:=True

For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
    .AutoFilter
    .AutoFilter Field:=3, Criteria1:=x.Value
    .SpecialCells(xlCellTypeVisible).Copy

Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x

'Turn off filter
Sheets(sht).AutoFilterMode = False

With Application
    .ScreenUpdating = True
    .CutCopyMode = False
End With


End Sub

Answer 1

You can use collections to filter out the unique items, instead of using the advanced filter.

Sub UsingCollection()
    Dim cUnique As Collection, ws As Worksheet, fRng As Range
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant

    Set sh = ThisWorkbook.Sheets("Filter This")
    Set Rng = sh.Range("C2:C" & sh.Cells(sh.Rows.Count, "C").End(xlUp).Row)
    Set cUnique = New Collection

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0

    For Each vNum In cUnique
        With sh
            Set fRng = .Range("C1:H" & .Cells(.Rows.Count, "C").End(xlUp).Row)
        End With
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        With ws
            .Name = vNum
            With fRng
                .AutoFilter Field:=3, Criteria1:=vNum
                fRng.Copy ws.Range("A1")
            End With
            .AutoFilterMode = False
        End With
    Next vNum

End Sub