问题
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