代码当前按照我需要的方式过滤数据,但是当它复制它时,它会复制所有不仅仅是过滤后的数据。我知道我可以使用.select然后复制和粘贴等工作。但我宁愿避免这种情况,如果可能的话。任何帮助,将不胜感激。
Sub Auto_Filter()
Dim RNG As Range
Dim Open_Jobs_Report As Worksheet
Set Open_Jobs_Report = ThisWorkbook.Sheets("Open Jobs Report")
Dim Dashboard As Worksheet
Set Dashboard = ThisWorkbook.Sheets("Dashboard")
Dim PersonResponsible As Range
Dim Violations As Range
Dim CLM1 As Long
Dim CLM2 As Long
With Sheets("Open Jobs Report")
Set RNG = .Range("A1", .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
RNG.AutoFilter Field:=19, Criteria1:="<>"
CLM1 = .Range("1:1").Find(What:="Person Responsible").Column
Set PersonResponsible = .Range(.Cells(1, CLM1), .Cells(1, CLM1).End(xlDown))
CLM2 = .Range("1:1").Find(What:="Violations").Column
Set Violations = .Range(.Cells(1, CLM2), .Cells(1, CLM2).End(xlDown))
End With
Dashboard.Range("B4:B1000").Value = PersonResponsible.Value
Dashboard.Range("E4:E1000").Value = Violations.Value
Dashboard.Range("B4:B1000").RemoveDuplicates , Header:=xlYes
Dashboard.Range("E4:E1000").RemoveDuplicates , Header:=xlYes
Open_Jobs_Report.ListObjects(1).AutoFilter.ShowAllData
End Sub
答案 0 :(得分:1)
这只会复制Open_Jobs_Report
表
Open_Jobs_Report.ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
评论后更新:
With Open_Jobs_Report.ListObjects(1)
Union(.ListColumns(9).DataBodyRange, .ListColumns(19).DataBodyRange).Copy
End With
或使用标题名称:
With Open_Jobs_Report.ListObjects(1)
Union(.ListColumns("Person Responsible").DataBodyRange, .ListColumns("Violations").DataBodyRange).Copy
End With
多思考一下这就是我可能会去做的事情:
Dim Open_Jobs_Report As Worksheet
Dim temp as Variant
Set Open_Jobs_Report = ThisWorkbook.Sheets("Open Jobs Report")
temp = Open_Jobs_Report.ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Value
With Dashboard
.Range(.Cells(4, 2), .Cells(3 + UBound(temp,1), 2)).Value = Application.Index(temp, , 9)
.Range(.cells(4, 5), .Cells(3 + UBound(temp, 1), 5)).Value = Application.Index(temp, , 19)
End With
这会将表的整个可见部分放入内存中的数组中,然后将范围设置为等于您感兴趣的位。
答案 1 :(得分:0)
您可能希望使用工作表的内置AutoFilter.Range对象。
ActiveSheet.AutoFilter.Range.Copy
Workbooks.Add.Worksheets(1).Paste