Excel VBA 高级过滤器不复制所有列

Question

I'm using AdvancedFilter for the first time in VBA. I'm trying to copy only specific columns from the source data table to an external workbook table. I've seen how it should be specified when doing it not in VBA, but it's not working in my code.

Currently, the filtering works and it's copying to the external workbook table, BUT it's copying all the headings and filtered data, and pasting everything into the external table, not just the columns that are in my external table.

The code runs without any error messages.

So the outcome I want is

• for it not to copy the source data ( SDCRange ) headings
• Only copy the columns that are in the external table ( copyToRng )

Current code:

Sub StockManagement(wb As Workbook, ws As Worksheet)
Dim TemplPath As String
Dim SMTemp As String
Dim SMTempF As String  

'Create Filter Criteria ranges
With MainWB.Worksheets.Add
    .Name = "FltrCrit"
    Dim FltrCrit As Worksheet
    Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With

With FltrCrit
    Dim DerangedCrit As Range
    Dim myLastColumn As Long

    'Create Deranged Filter Criteria Range
    .Cells(1, "A") = "Deranged"
    .Cells(2, "A") = "MS"
    .Cells(3, "A") = "<>4"
    .Cells(2, "B") = "SOH"
    .Cells(3, "B") = "=0"

    'get last column, set range name
    With .Cells

        'find last column of data cell range
        myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

        'specify cell range
        Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))

    End With


'Copy Filtered data to specified tables
Dim tblSDC As ListObject, tblFiltered As ListObject
Dim shSDC As Worksheet, shFiltered As Worksheet
Dim critRange As Range, copyToRng As Range, SDCRange As Range

'Assign values to sheet variables
Set shSDC = MainWB.Worksheets(2)
Set shFiltered = wb.Worksheets("Deranged with SOH")

'Turn off autofilter on filtered tab
shFiltered.AutoFilterMode = False

'Store Filtered table in variable
Set tblFiltered = shFiltered.ListObjects("Table_Deranged_with_SOH")
Set tblSDC = shSDC.ListObjects("Table_SDCdata")

'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData

'Set Criteria range to variable
Set critRange = DerangedCrit

'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.DataBodyRange(1, 1)
Set SDCRange = tblSDC.Range

'Use Advanced Filter
SDCRange.CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critRange, CopyToRange:=copyToRng, Unique:=False

Any help will be appreciated.

EDIT:

If I set the external/output range to

Set copyToRng = tblFiltered.HeaderRowRange

It makes sense to me that it'll behave in the same way as if you used the Advanced Filter without VBA. So you set the output table range to the output table range headers, and that should then just copy all the columns that match. BUT when I do that, nothing is copied, the output/external table is empty.

So any suggestions will be helpful thanks.

Answer 1

Untested but should get you on the right track:

Sub StockManagement(wb As Workbook, ws As Worksheet)

    Dim FltrCrit As Worksheet
    Dim DerangedCrit As Range
    Dim tblSDC As ListObject, tblFiltered As ListObject
    Dim m As Variant, c As Range


    Set FltrCrit = MainWB.Worksheets.Add()
    With FltrCrit
        .Name = "FltrCrit"
        .Cells(1, "A") = "Deranged"
        .Cells(2, "A") = "MS"
        .Cells(3, "A") = "<>4"
        .Cells(2, "B") = "SOH"
        .Cells(3, "B") = "=0"
        Set DerangedCrit = .Range(.Cells(2, "A"), _
                                  .Cells(2, .Columns.Count).End(xlToLeft)).Resize(2)
    End With

    Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")
    tblFiltered.AutoFilter.ShowAllData

    Set tblSDC = MainWB.Worksheets(2).ListObjects("Table_SDCdata")
    tblSDC.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=DerangedCrit

    'loop over the headers in the destination table
    For Each c In tblFiltered.HeaderRowRange.Cells
        m = Application.Match(c.Value, tblSDC.HeaderRowRange, 0) 'matched source header?
        If Not IsError(m) Then
            'got a match - copy visible cells for this column
            tblSDC.ListColumns(c.Value).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
                    c.Offset(1, 0)
        End If
    Next c

End Sub

Answer 2

Mystery solved, It was a silly error. The code works absolutely fine, the problem that the external/output table was empty was because one of my headers in the external/output table had an extra space in, so it couldn't match to the source data headers.

I did adjust the code slightly to remove some of the variables (as suggested by @Tim Williams) above.

Code now looks as like this:

Sub StockManagement(wb As Workbook, ws As Worksheet)
Dim TemplPath As String
Dim SMTemp As String
Dim SMTempF As String  

'Create Filter Criteria ranges
With MainWB.Worksheets.Add
    .Name = "FltrCrit"
    Dim FltrCrit As Worksheet
    Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With

With FltrCrit
    Dim DerangedCrit As Range
    Dim myLastColumn As Long

    'Create Deranged Filter Criteria Range
    .Cells(1, "A") = "Deranged"
    .Cells(2, "A") = "MS"
    .Cells(3, "A") = "<>4"
    .Cells(2, "B") = "SOH"
    .Cells(3, "B") = "=0"

    'get last column, set range name
    With .Cells

        'find last column of data cell range
        myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

        'specify cell range
        Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))

    End With

'Copy Filtered data to specified tables
Dim tblFiltered As ListObject
Dim copyToRng As Range, SDCRange As Range

'Store Filtered table in variable
Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")

'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData

'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.HeaderRowRange
Set SDCRange = MainWB.Worksheets(2).ListObjects("Table_SDCdata").Range

'Use Advanced Filter
SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DerangedCrit, CopyToRange:=copyToRng, Unique:=False