VBA 循环通过 IF 语句

Question

对 VBA 编程有点陌生，但需要它来完成一个项目。

我基本上是在尝试基于 IF 语句复制和粘贴单元格，并且希望逐个单元格地执行此操作，因此我合并了一个循环。代码如下所示。最终发生的是第一行被复制/粘贴得很好，但循环没有继续。当我使用 debug.print i 时，唯一填充的数字是 6。我也尝试过For 声明，但最终表现相同。有什么想法吗？

Private sub Copy_Dates()
Dim i as Integer
i =6 

Do 
   If Cells(i,79)= 1 then 
       Sheets("Tracking").Select
       Range(Cells(i,106),Cells(i,108)).Copy

       Sheets("Tr_Tracking").Select
       Range(Cells(i_25003,2),cells(i+25003,4)).PasteSpecial Paste:=xlPasteValues
   End if 
i= i+1
Loop while i < 10

End sub

编辑： 所以我意识到我想要的代码不再对我的项目很有帮助。我真正需要的是一种基于标准选择非连续单元格的方法，然后将这些单元格作为单个块复制到另一个工作表中。

所以，从上面的代码中，我需要确保选择

.range(.cells(i,106,.cells(i,108))

仅当满足以下条件时：

if .cells(i,79)=1

然后想象一下，我将有一些基于此条件的选定单元格数组，然后我可以将其粘贴到上面定义的第二张表wsO=thisworkbook.sheets("TR_Tracking")。

我希望这是有道理的，希望逻辑不要太复杂。

编辑：编辑： 我能够弄清楚这一点。我使用下面的代码来完成上面的编辑部分。

Private Sub SelectArray_andCopy()
Dim FinalSelection as Range
Sheets("Tracking").Select
Cells(2,79).Select
For each c in intersect(activesheet.usedrange,range("CA6:CA500"))
    if c.value=1 then 
        if finalselection is nothing then   
            set finalselection=range(cells(c.row,106),cells(c.row,108))
        else
            set finalselection = union(finalselection, range(cells(c.row,106,cells(c.row,108)))
        end if 
    end if 
next c 
if not finalselection is nothing then finalselection.select

Selection.copy
Sheets("TR_Tracking").Select
Range("b250009,d26000").PasteSpecial Paste:=xlPasteValues

Answer 1

问题是您正在使用.Select，因此焦点正在改变。此外，您的单元格对象也不完全合格。

INTERESTING READ

进一步i_25003 不正确。我猜你的意思是i + 25003

试试这个（未测试）

Private Sub Copy_Dates()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim i As Long

    Set wsI = ThisWorkbook.Sheets("Tracking")
    Set wsO = ThisWorkbook.Sheets("Tr_Tracking")

    For i = 6 To 9
        With wsI
            If .Cells(i, 79) = 1 Then
               wsO.Range(wsO.Cells(i + 25003, 2), wsO.Cells(i + 25003, 4)).Value = _
               .Range(.Cells(i, 106), .Cells(i, 108)).Value
            End If
        End With
    Next i
End Sub