vba 创建一个宏以根据条件将多行数据从一张工作表复制到另一张工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17303047/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
create a macro to copy multiple rows of data from one sheet to another based on a criteria
提问by Avinash Chugani
I am trying to write a macro that will let me copy a range of data from one sheet to another sheet based on a criteria in the column before the column to be copied.
我正在尝试编写一个宏，它可以让我根据要复制的列之前的列中的条件将一系列数据从一张工作表复制到另一张工作表。
Column B is the criteria column. If there is a 1 in any row in this column then columns C thru AN will be copied from that row where there is a 1 and be pasted into another sheet starting at the top of that sheet.
B 列是标准列。如果此列中的任何行中有 1，则 C 到 AN 列将从有 1 的那一行复制，并粘贴到从该工作表顶部开始的另一张工作表中。
I have the following code. It locates the first row that satisfies the criteria and copies this row to the second sheet, however the code does not loop thru to find other rows that satisfy the criteria. How can I adjust the code to loop and copy each instance where the criteria is satisfied?
我有以下代码。它定位满足条件的第一行并将该行复制到第二个工作表，但是代码不会循环查找满足条件的其他行。如何调整代码以循环并复制满足条件的每个实例？
Sub testIt()
Dim i As Integer
Application.ScreenUpdating = False
Sheets("DataDump").Activate
For i = 2 To Range("B2").End(xlDown).Row()
If Range("B" & i).Value = 1 Then
Range("C" & i, "AN" & i).Copy
Sheets("PriceData").Activate
ActiveSheet.Range("B2", "AM2").Select
ActiveSheet.Paste
End If
Next i
Application.ScreenUpdating = True
End Sub
采纳答案by Tim Williams
Sub testIt()
Dim i As Long, shtSrc As Worksheet, rngDest As Range
Application.ScreenUpdating = False
Set shtSrc = Sheets("DataDump")
Set rngDest = Sheets("PriceData").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
For i = 2 To shtSrc.Range("B2").End(xlDown).Row
If shtSrc.Range("B" & i).Value = 1 Then
shtSrc.Range("C" & i & ":AN" & i).Copy rngDest
Set rngDest = rngDest.Offset(1, 0)
End If
Next i
Application.ScreenUpdating = True
End Sub
