Excel VBA 過濾器復制並粘貼到單獨工作表上最后使用的行下

Question

我有以下宏來過濾結果，但是我想自動將過濾后的結果 ($A:$M) 復制並粘貼到最后使用的行下的“過濾器”表中。

此外，有時過濾器將沒有結果，因此需要一些東西來解決這個問題。

Sub FilterResults()

    Sheets("RESULTS").Select
    ActiveSheet.Range("$A$1:$M$1006001").AutoFilter Field:=13, Criteria1:=">0", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$M$1006001").AutoFilter Field:=12, Criteria1:="<=15" _
        , Operator:=xlAnd

End Sub

任何幫助將不勝感激，因為我是 VBA 的新手。

提前致謝

Answer 1

嘗試這個

Dim targetSht As Worksheet
Set targetSht = Worksheets("Filter")

With Sheets("RESULTS").Range("$A$1:$M$1006001")
    .AutoFilter Field:=13, Criteria1:=">0", Operator:=xlAnd
    .AutoFilter Field:=12, Criteria1:="<=15", Operator:=xlAnd
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(XlCellType.xlCellTypeVisible).Copy Destination:=targetSht.Cells(targetSht.Rows.Count, 1).End(xlUp).Offset(1)
    .Parent.AutoFilterMode = false ' remove filtering
End With

如果你想繼續粘貼標題然后改變

.Offset(1).Resize(.Rows.Count - 1).SpecialCells(XlCellType.xlCellTypeVisible).Copy ...

到

.SpecialCells(XlCellType.xlCellTypeVisible).Copy ...

---

上述內容的增強（評論中的解釋）如下：

Sub FilterResults()

        Dim targetSht As Worksheet
        Set targetSht = Worksheets("Filter")

        With Sheets("RESULTS") 'reference source sheet
            With .Range("A1", .Cells(.Rows.Count, 13).End(xlUp)) ' reference referenced sheet column A to M from row 1 down to column A last not empty cell. this reduces the handled cells and then computational effort
                .AutoFilter Field:=13, Criteria1:=">0"
                .AutoFilter Field:=12, Criteria1:="<=15"
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(XlCellType.xlCellTypeVisible).Copy Destination:=targetSht.Cells(targetSht.Rows.Count, 1).End(xlUp).Offset(1) ' copy filtered cells skipping headers and paste them to "target" sheet starting from its column A first empty cell
            End With
            .AutoFilterMode = false ' remove filtering
        End With

    End Sub