复制过滤表

Question

尝试复制过滤后的表格并将结果粘贴到另一个表格的底部。

With RollupWeekSheet
   sh1Col = .Range("Table1").Cells(1).Column
   LastRollupWeekRow = .Cells(.Rows.Count, sh1Col).End(xlUp).Row
End With


Dim ComboWeekTable As ListObject
Set ComboWeekTable = ComboWeekSheet.ListObjects("Table1")

Dim RollupTimeStamp As Date
RollupTimeStamp = RollupWeekSheet.Range("B3").Value

With ComboWeekTable
.Range.AutoFilter Field:=16, Criteria1:=">" & RollupTimeStamp
.DataBodyRange.Copy
End With

With RollupWeekSheet
.Cells(LastRollupWeekRow + 1, sh1Col).PasteSpecial xlPasteValues
ComboWeekTable.Range.AutoFilter Field:=1

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

With ComboWeekSheet
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With

它一直突出显示位于我的“With ComboWeekTable”行下的“.Autofilter”并说“无效使用属性”，但我不知道为什么。请帮忙。

Answer 1

这是获取 ListObject 正确属性的情况

假设您只需要过滤后的数据行（而不是标题）：

With ComboWeekTable
    .Range.AutoFilter Field:=4, Criteria1:=">" & RollupTimeStamp
    .DataBodyRange.Copy
End With

与SpecialCells 不同，如果过滤器不返回任何行（没有错误，不粘贴任何内容），这仍然有效，因此不需要错误捕获

演示

Sub Demo()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lo As ListObject

    Set ws1 = ActiveSheet
    Set ws2 = ws1.Parent.Worksheets(ws1.Index + 1)
    Set lo = ws1.ListObjects(1)

    If lo.AutoFilter Is Nothing Then lo.Range.AutoFilter
    lo.ShowAutoFilterDropDown = True
    With lo
        .Range.AutoFilter Field:=1, Criteria1:="=2"
        If Application.Aggregate(3, 5, lo.ListColumns(1).DataBodyRange) > 0 Then 'Count All, ignoring hidden rows
            .DataBodyRange.Copy
            ws2.Range("D5").PasteSpecial xlPasteValues
        End If
        lo.AutoFilter.ShowAllData ' clear filter
    End With
End Sub

运行演示之前

运行Demo后

Answer 2

已编辑以匹配您的设置。这在测试中对我有用：

Sub Tester()

    Dim rngPaste As Range, ComboWeekTable As ListObject
    Dim RollupTimeStamp As Date

    'find the paste position
    With RollupWeekSheet.ListObjects("Table2").DataBodyRange
       Set rngPaste = .Rows(.Rows.Count).Cells(1).Offset(1, 0)
    End With

    Set ComboWeekTable = ComboWeekSheet.ListObjects("Table1")

    RollupTimeStamp = RollupWeekSheet.Range("B3").Value

    With ComboWeekTable.DataBodyRange
        .AutoFilter Field:=16, Criteria1:=">" & RollupTimeStamp

        On Error Resume Next '<< ignore run-time error if no rows visible
        .SpecialCells(xlCellTypeVisible).Copy rngPaste
        On Error GoTo 0      '<< stop ignoring errors

        .AutoFilter
    End With

    ComboWeekTable.Range.AutoFilter Field:=1

End Sub