SpecialCells(xlCellTypeVisible)

时间:2016-11-17 23:15:30

标签: excel vba excel-vba

我有15列数据,行数范围从400到1000,我已应用过滤器,我热衷于只将D和J列的可见单元复制到不同的工作表上,但通过转置粘贴特殊值进入D6范围。

我已经使用了下面这个方法,但它只复制了两个可见的行,而不是根据代码复制每一行,就像过去我为修改它后运行的其他工作表一样。问题可能是我在一个宏中运行了三个或四个进程。

我很想知道如何修改此代码,以便复制列d和列j可见单元格,将标题排除在不同的表格中

那么我在哪里代表代码,它运行并应用过滤器,但是无法复制宏的这个特定部分的所有行,其次,我很想知道如何修改它以便它只复制列D和J如上所述排除标题,仅复制可见单元格以通过转置粘贴特殊值。

Set rngToCopy = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
Report.Range("D6").PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True


Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim rngToCopy As Range, rRange As Range

    Set ws = Sheets("Sheet1")

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rRange = .Range("A1:A" & lRow)

        '~~> Remove any filters
        .AutoFilterMode = False

        With rRange 'Filter, offset(to exclude headers) and copy visible rows
            .AutoFilter Field:=1, Criteria1:="<>"
            Set rngToCopy = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        '~~> Remove any filters
        .AutoFilterMode = False

        rngToCopy.Copy

        '
        '~~> Rest of the Code
        '
    End With
End Sub

我将thomas代码添加到子片段以查看自动过滤器是否正常工作并获得错误91

Sub Filter()
Dim Sheetx As Worksheet
Dim rngToCopy As Range, rRange As Range

With Sheetx

Set rRange = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))

With rRange

.AutoFilter Field:=11, Criteria1:="30"
.AutoFilter Field:=4, Criteria1:="1"
.AutoFilter Field:=2, Criteria1:="=*1", _
Operator:=xlAnd


With .SpecialCells(xlCellTypeVisible)

Set rngToCopy = Union(.Offset(0, 3), .Offset(0, 9))

End With

rngToCopy.Copy

End With
End With

End Sub

1 个答案:

答案 0 :(得分:0)

我们可以使用Node*&Union加入单元格来定义范围。

MSDN: Application.Union Method (Excel)

  

返回两个或多个范围的并集。

Range.Offset