按条件过滤然后复制并粘贴到同一工作表的底部

Question

我是 VBA 的新手，经过大量搜索后，我无法让代码正常工作。我正在尝试 filter/select B 列中值为 313 且 C 列中值为 1 或 2 的任何内容，然后使用同一工作表底部所有列 (A-N) 中的数据复制所有相关行。工作表没有固定的行数，并且 313 并不总是在同一组单元格中。我尝试了以下方法，但代码似乎粘贴在 'A2' 中，而不是底部的选择。任何帮助将不胜感激。

Sub CopyPartOfFilteredRange()
Dim ws1 As Worksheet
Dim filterRange As range
Dim copyRange As range
Dim lastRow As Long

Set ws1 = ThisWorkbook.Sheets("Sheet 1")

ws1.AutoFilterMode = False

lastRow = ws1.range("A" & ws1.Rows.Count).End(xlUp).Row

Set filterRange = ws1.range("A1:N" & lastRow)


Set copyRange = ws1.range("A2:N" & lastRow)

 filterRange.AutoFilter Field:=2, Criteria1:="313"
filterRange.AutoFilter Field:=3, Criteria1:="=1", _
    Operator:=xlAnd, Criteria2:="=2"


lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  ws1.Cells(lastRow, 1).Select
ws1.Paste


 ws1.AutoFilterMode = False
End Sub

Answer 1

我相信因为您正在重新定义过滤器后的最后一行，所以使用 xlUp 会错过最后一行，因为它可能隐藏在过滤器中。我建议使用

lastRow = lastRow + 1

因为您已经定义了范围的最后一行，而您只想越过该范围的下一行。

顺便说一句，你的第二个过滤器将不过滤任何东西，因为没有单元格会同时等于 1 和等于 2。不确定你想要什么。无论如何，就像我在评论中所说的，我不相信你在复制任何东西，所以你需要

filterRange.Copy

过滤后。我不确定我是否会推荐像这样复制和粘贴，但我将尝试只修改您的代码而不是重写它。

另外，我不相信

Set copyRange = ws1.range("A2:N" & lastRow)

根本不需要，可以删除。

这是我的全部

Sub CopyPartOfFilteredRange()
Dim ws1 As Worksheet
Dim filterRange As Range
Dim lastRow As Long
Set ws1 = Worksheets("Sheet1")
ws1.AutoFilterMode = False
lastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
Set filterRange = ws1.Range("A1:N" & lastRow)
filterRange.AutoFilter Field:=2, Criteria1:="313"
filterRange.Copy
lastRow = lastRow + 1
ws1.Cells(lastRow, 1).Select
ws1.Paste
ws1.AutoFilterMode = False
End Sub

Answer 2

你必须：

把xlAnd改成xlOr
增加 lastRow 以引用要粘贴的单元格
使用 SpecialCells(xlCellTypeVisible) 来 select 过滤单元格（如果有的话！）

试试他的

Option Explicit

Sub CopyPartOfFilteredRange()
    Dim lastRow As Long

    With ThisWorkbook.Sheets("Sheet 1")
        .AutoFilterMode = False

        lastRow = .Range("A" & .Rows.Count).End(xlUp).row
        With .Range("A1:N" & lastRow)
            .AutoFilter Field:=2, Criteria1:="313"
            .AutoFilter Field:=3, Criteria1:="1", Operator:=xlOr, Criteria2:="2"
            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 .Cells(lastRow + 1, 1)
            End If
        End With

         .AutoFilterMode = False
     End With
End Sub

按条件过滤然后复制并粘贴到同一工作表的底部

filter on criteria then copy and paste at bottom of same worksheet

excel

vba

copy-paste

autofilter