使用 xlFilterCopy 的高级过滤器

Question

I an trying to copy some dynamic data from another worksheet called "Pivot Table - CE" through AdvancedFilter function into another worksheet called "CO" using Advanced Filter. The input data is basically, the output from a Pivot table (the Pivot table itself is working fine). I am getting the following error

Run-time error '5': Invalid procedure call or argument.

The error seems to be in the AdvancedFilter line

Dim rngData As Range, rngCriteria As Range, rngOutput As Range
Set rngData = Sheets("Pivot Table - CE").Range("A3:F" & Cells(Rows.Count, "F").End(xlUp).Row)
Set rngCriteria = Sheets("Pivot Table - CE").Range("H3:K4")
Set rngOuput = Sheets("CO").Range("B4")
rngData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, CopyToRange:=rngOutput, Unique:=False

Answer 1

Using AdvancedFilter with xlFilterCopy

• The following image illustrates
  • how to utilize some of the AdvancedFilter features and
  • what the RefCurrentRegion function references.
• For clarity, the filter is applied to only one worksheet while the code copies the result to another worksheet.

Option Explicit

Sub AdvancedFilterCopy()
    Const ProcName As String = "AdvancedFilterCopy"
    On Error GoTo ClearError

    ' Note that all cell addresses refer to the first cell of the headers.
        
    ' Source Data
    Const sdName As String = "Pivot Table - CE"
    Const sdfCellAddress As String = "A3"
    ' Source Criteria
    Const scName As String = "Pivot Table - CE"
    Const scfCellAddress As String = "H3"
    ' Destination
    Const dName As String = "CO" ' "Pivot Table - CE"
    Const dfCellAddress As String = "B4" ' "O3"
    Const dUnique As Boolean = True
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Source Data
    Dim sdws As Worksheet: Set sdws = wb.Worksheets(sdName)
    Dim sdfCell As Range: Set sdfCell = sdws.Range(sdfCellAddress)
    Dim sdrg As Range: Set sdrg = RefCurrentRegion(sdfCell)
    
    ' Source Criteria
    Dim scws As Worksheet: Set scws = wb.Worksheets(scName)
    Dim scfCell As Range: Set scfCell = scws.Range(scfCellAddress)
    Dim scrg As Range: Set scrg = RefCurrentRegion(scfCell)
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dfCellAddress)
    Dim drg As Range: Set drg = RefCurrentRegion(dfCell)
    If drg.Rows.Count > 1 Then ' clear previous data
        drg.Resize(drg.Rows.Count - 1).Offset(1).ClearContents
    End If
    Dim dhrg As Range: Set dhrg = drg.Rows(1) ' reference headers
    
    ' Filter Copy
    sdrg.AdvancedFilter xlFilterCopy, scrg, dhrg, dUnique

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns a reference to the range starting with the first cell
'               of a range and ending with the last cell of the first cell's
'               Current Region.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCurrentRegion( _
    ByVal FirstCell As Range) _
As Range
    Const ProcName As String = "RefCurrentRegion"
    On Error GoTo ClearError

    If FirstCell Is Nothing Then Exit Function
    With FirstCell.Cells(1).CurrentRegion
        Set RefCurrentRegion = FirstCell.Resize(.Row + .Rows.Count _
            - FirstCell.Row, .Column + .Columns.Count - FirstCell.Column)
    End With

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function