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

因此，我现在编写代码来检查一列，然后检查单元格中的值是否符合条件。如果是，代码应该复制整行或将该行添加到剪贴板。但是我现在遇到的问题是，如果有多个单元格符合条件，最终结果只是我复制的最后一行。我该如何解决这个问题？如何用循环复制非连续的行[vba]？

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。我能做些什么来解决这个问题？

来源

2017-05-10 Isayah

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

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

来源

2017-05-10 13:50:52 Moosli

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

回答

相关问题