Скопировать отфильтрованную таблицу

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

Он продолжает выделять строку «.Autofilter», расположенную под моей строкой «With ComboWeekTable» и говоря «Недопустимое использование».собственности ", но я не знаю почему.Пожалуйста, помогите.

Answer 1

Это случай получения правильных свойств объекта ListObject

. Предполагается, что вам нужны только строки отфильтрованных данных (а не заголовок):

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

В отличие от SpecialCells thisпо-прежнему работает, если фильтр не возвращает строк (без ошибок, ничего не вставляет), поэтому нет необходимости перехватывать ошибки

Demo

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