仅使用.select或.End(xlDown)传输可见行

时间:2016-05-25 23:42:43

标签: excel vba excel-vba

代码当前按照我需要的方式过滤数据,但是当它复制它时,它会复制所有不仅仅是过滤后的数据。我知道我可以使用.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

2 个答案:

答案 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

This link gives the full explanation