Question

我有一个由4列和未确定的行组成的列表。我试图只收集Col B和C，其中Col B有单词Jackpot并将它们复制到一张新表中。我已经将列表排序，但使用UsedRange，复制所有行。我如何仅复制B和C？

Range("A1").Activate
ActiveCell.EntireRow.Insert
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="Jackpot"

ActiveSheet.UsedRange.Select

Col A | Col B |      Col C | Col D
1       Stuff          1       1
1       MoreStuff      2       1
1       Jackpot        3       1
1       Jackpot        4       1
1       SomeStuff      5       1
1       Jackpot        6       1

Answer 1

过滤后，您可以选择范围B：C，然后复制到目的地。我更新了您的代码以向您展示示例。此外，您并不总是需要使用VBA“选择”任何内容（非常罕见）。

希望这有帮助

Option Explicit

Sub doIt()
    Dim sh As Worksheet
    Set sh = ActiveSheet

    sh.Range("A1:D1").AutoFilter Field:=2, Criteria1:="Jackpot"

    ' make sure results were returned from the filter
    If (sh.Cells(sh.Rows.Count, 1).End(xlUp).Address <> "$A$1") Then

        Dim newSh As Worksheet
        Set newSh = Sheets.Add

        sh.Range("B:C").Copy newSh.Range("A1")

    End If
End Sub

Answer 2

首先，虽然我确实有一些问题：

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Results")
ws.Rows(1).AutoFilter Field:=2, Criteria1:="Jackpot"
ws.Range("B2:C2", Range("B2:C2").End(xlDown)).Copy
ThisWorkbook.Worksheets("DestinationSheet").Range("A1").PasteSpecial

1）每次都会在同一张纸上发生这种情况（例如Worksheets("Results")）吗？ 2）你想要包括标题行吗？如果是，请在两个实例中将.Copy行更改为B1:C1。当前实现只接受没有标头的过滤内容。

显然，您需要更改工作表名称以符合您的实施。

Answer 3

这是一种不依赖自动过滤器的简单方法。不确定速度更快，但我想为你的问题提供另一种解决方案。

Sub CopyJackpot()
Application.ScreenUpdating = False
Dim lastRow As Long, i As Long, j As Long

j = 1
lastRow = Range("B" & Rows.Count).End(xlUp).Row

For i = 1 To lastRow
    If InStr(Range("B" & i).Value, "Jackpot") Then
       Rows(i).Copy Destination:=Sheets(2).Rows(j)
       j = j + 1
    End If
Next

Application.ScreenUpdating = True
MsgBox j - 1 & " row(s) copied to Sheet2."

End Sub

Vba：根据文本选择多行

3 个答案: