使用自动过滤器将可见单元格复制到变量

时间:2015-09-23 17:35:50

标签: arrays excel-vba copy range autofilter

我正在使用AutoFilter在运行不同的宏之前删除某些行。我的一个过滤器会显示一些我需要保存以便以后粘贴的注释。我假设将它保存到变量将允许我删除这些行并在以后需要时粘贴它们。这是我到目前为止所做的:

Sub Test()
    With Sheet1
        .AutoFilterMode = False
        With Range("A10", Range("A" & Rows.Count).End(xlUp))
            On Error Resume Next
            .AUTOFILTER Field:=1, Criteria1:="=(**", Operator:=xlFilterValues
            'Insert code to copy values to variable here
            .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
End Sub

我无法弄清楚如何将可见细胞复制到变量中。尝试使用xlCellTypeVisible,但它不起作用。

1 个答案:

答案 0 :(得分:0)

所以我明白了。这是下面的代码

With Sheet1
.AutoFilterMode = False
With Range("A10", Range("A" & Rows.Count).End(xlUp))
    On Error Resume Next
    .AUTOFILTER Field:=1, Criteria1:="=Device*", Operator:=xlFilterValues
    .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.delete
    .AUTOFILTER Field:=1, Criteria1:="=Manufacturer", Operator:=xlFilterValues
    .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.delete
    .AUTOFILTER Field:=1, Criteria1:="=(**", Operator:=xlFilterValues
    Set MyRange = Sheet1.Range("A10: I" & Cells(Rows.Count - 1, 1).End(xlUp).Row).Offset(1, 0).SpecialCells(xlCellTypeVisible)
    CalVal = MyRange
    .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.delete
End With
.AutoFilterMode = False
End With

这会删除我需要删除的行,同时保存以“(”。

开头的行)

稍后我会在复制完所有内容后将其粘贴到第2页。

'Paste Notes
NumRows = UBound(CalVal, 1) - LBound(CalVal, 1) + 1
NumCols = UBound(CalVal, 2) - LBound(CalVal, 2) + 1
Set Destination = ws2.Range("A" & lastRow).Offset(1, 0)
Destination.Value = "Table Notes"
Destination.Font.Bold = True
Set Destination = ws2.Range("A" & lastRow).Resize(NumRows, NumCols).Offset(2, 0)
Destination = CalVal

当然需要暗淡MyRange,CalVal,LastRow,NumRows和NumCols