Copy a Filtered Table

喜欢而已 提交于 2020-01-05 06:56:26

问题


Trying to copy a filtered table and paste the results to the bottom of another table.

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

It keeps highlighting the ".Autofilter" located under my "With ComboWeekTable" line and saying "Invalid use of property", but I don't know why. Please help.


回答1:


It's a case of getting to the correct properties of the ListObject

Assuming you want just the filtered data rows (and not the header):

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

Unlike SpecialCells this still works if the filter returns no rows (no error, doesn't paste anything), so no need for error trapping

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

Before running Demo

After running Demo




回答2:


EDITED to match your setup. This worked for me in testing:

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


来源:https://stackoverflow.com/questions/56469221/copy-a-filtered-table

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!