Sub bb()
Dim x
For Each x In ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
    Cells(2, 5) = x.Value
Next
End Sub

Sub Extract_Unique()
    Dim vItem, avArr, li As Long
    ReDim avArr(1 To Rows.Count, 1 To 1)
    With New Collection
        On Error Resume Next
        For Each vItem In Range("A6", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
            'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А
            .Add vItem, CStr(vItem)
            If Err = 0 Then
                li = li + 1: avArr(li, 1) = vItem
            Else: Err.Clear
            End If
        Next
    End With
    If li Then [E2].Resize(li).Value = avArr
End Sub

Function GetFilter(ByRef Cell As Range) As String
On Error GoTo err
GetFilter = "-"
With Cell.Parent.AutoFilter.Filters(Cell.Column - Cell.Parent.AutoFilter.Range.Column + 1)
    If .On Then
        Select Case .Operator
        Case 0
            GetFilter = Replace(.Criteria1, "=", "")
        Case xlFilterValues
            GetFilter = Replace(Join(.Criteria1, ","), "=", "")
        Case xlOr
            GetFilter = Replace(.Criteria1 & "," & .Criteria2, "=", "")
        End Select
    Else
        GetFilter = "*"
    End If
End With
err:
End Function