Sub PreserveAutofilter()
    Dim tbl As ListObject, r As Range
    Const COL_OFFSET% = 1
    Set r = ActiveSheet.AutoFilter.Range
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, r, , xlYes)
    tbl.Resize tbl.Range.Cells(1).Resize(tbl.Range.Rows.Count, tbl.Range.Columns.Count + COL_OFFSET)
End Sub

Sub PreserveAutofilter2()
    Dim i%, r As Range, fs As Filters
    Dim arr()
    Const COL_OFFSET% = 1
    If Not ActiveSheet.AutoFilterMode Then Exit Sub

    Set fs = ActiveSheet.AutoFilter.Filters
    ReDim arr(1 To 3, 1 To fs.Count)
    For i = 1 To fs.Count
        If fs(i).On Then
            arr(1, i) = fs(i).Criteria1
            '            arr(2, i) = fs(i).Criteria2
            arr(3, i) = fs(i).Operator
        End If
    Next i

    Set r = ActiveSheet.AutoFilter.Range
    Set r = r.Columns(1).Resize(, r.Columns.Count + COL_OFFSET)
    ActiveSheet.AutoFilterMode = False
    For i = 1 To UBound(arr, 2)
        If Not IsEmpty(arr(1, i)) Then
            r.AutoFilter Field:=i, Criteria1:=arr(1, i), Operator:=arr(3, i)
        End If
    Next i
End Sub