2

我有一个由 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
4

3 回答 3

3

过滤后，您可以选择 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
于 2012-12-05T03:04:33.027 回答
3

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

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。当前的实现只采用没有标题的过滤内容。

显然，您需要更改工作表名称以匹配您的实现。

于 2012-12-05T03:11:26.900 回答
1

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

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
于 2012-12-05T07:22:03.887 回答