excel - 如何过滤范围并复制到不同工作表中的表格底部？

Question

我正在尝试筛选并选择在 R 列中包含值“New”的所有列(A 到 R)。然后我想复制此选择并将其作为值粘贴到工作表“Worklist”上的表格底部".

我不明白为什么代码使用“If”函数来查看小计，并认为我的复制和粘贴部分有误，因为我遇到了错误。

Sub CopyPartOfFilteredRange()
    Dim lastRow As Long
    With ThisWorkbook.Sheets("ProcessingSheet")
        .AutoFilterMode = False

        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        With .Range("A1:R" & lastRow)
            .AutoFilter Field:=18, Criteria1:="New"
            If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then 'count visible cells in column "A" other than the header
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destinations:=Sheets("Worklist").Cells(.Range("B" & .Rows.Count).End(xlUp).Row + 1, 1)
            End If
    
        End With
     End With
End Sub

Answer 1

复制过滤数据专长。小计

• Range.Subtotal method

如果 AutoFilter 未找到匹配值，

• SpeacialCells 将引发错误。 Subtotal 用于通过返回找到的值的数量来避免这种情况。

代码

Option Explicit

Sub CopyPartOfFilteredRange()
    With ThisWorkbook.Sheets("ProcessingSheet")
        .AutoFilterMode = False
        Dim lastRow As Long: lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        With .Range("A1:R" & lastRow)
            .AutoFilter Field:=18, Criteria1:="New"
            If WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then
                Dim dws As Worksheet
                Set dws = ThisWorkbook.Worksheets("Worklist")
                .Offset(1).Resize(.Rows.Count - 1) _
                    .SpecialCells(xlCellTypeVisible).Copy _
                    Destination:=dws.Cells(dws.Range("B" & dws.Rows.Count) _
                    .End(xlUp).Row + 1, 1)
            End If
        End With
        .AutoFilterMode = False
     End With
End Sub