如何用循环复制非连续的行？

所以我现在编写代码来查看列，然后检查单元格中的值是否符合条件。 如果是，代码应该复制整个行或将该行添加到剪贴板。 但我现在的问题是，如果有多个单元格符合标准，最终结果只是我复制的最后一行。 我该如何解决这个问题？

wbTarget.Worksheets("Sheet1").UsedRange.ClearContents wbSrc.Activate Application.CutCopyMode = False Do While wbSrc.Worksheets("R").Cells(j, "G").Value <> Empty If InStr(wbSrc.Worksheets("R").Cells(j, "G").Value, LogID) Then wbSrc.Worksheets("R").Range(wbSrc.Worksheets("R").Cells(j, "G"), wbSrc.Worksheets("R").Cells(j, "J")).Copy End If j = j + 1 Loop wbTarget.Worksheets("Sheet1").Range("A1").PasteSpecial Application.CutCopyMode = False wbTarget.Save wbTarget.Close wbSrc.Activate Set wbTarget = Nothing Set wbSrc = Nothing 

因此，如果第1,4,9,50,74,90,150行符合条件，那么这个代码只会复制（添加到剪贴板）第150行。我能做些什么来解决这个问题？

Answer 1

您需要在循环中进行复制。

 wbTarget.Worksheets("Sheet1").UsedRange.ClearContents wbSrc.Activate Application.CutCopyMode = False Dim idx as Integer idx = 1 Do While wbSrc.Worksheets("R").Cells(j, "G").Value <> Empty If InStr(wbSrc.Worksheets("R").Cells(j, "G").Value, LogID) Then wbSrc.Worksheets("R").Range(wbSrc.Worksheets("R").Cells(j, "G"),wbSrc.Worksheets("R").Cells(j, "J")).Copy wbTarget.Worksheets("Sheet1").Range("A" & idx).PasteSpecial Application.CutCopyMode = False idx = idx +1 End If j = j + 1 Loop wbTarget.Save wbTarget.Close wbSrc.Activate Set wbTarget = Nothing Set wbSrc = Nothing