VBA Looping через заявление 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 

EDIT: Так я понял, что код, который я хотел не собирается быть очень полезным для моего проекта больше. То, что мне действительно нужно, - это метод выбора не последовательных ячеек на основе критериев, а затем скопировать эти ячейки на другой рабочий лист в виде одного блока.

Таким образом, принимая из кода выше, мне нужно, чтобы убедиться, чтобы выбрать

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

только тогда, когда выполняется следующее условие:

if .cells(i,79)=1 

затем представьте себе, что я бы иметь некоторый массив выбранные ячейки на основе этого условия, а затем я мог бы вставить его во второй лист, определенный выше wsO=thisworkbook.sheets("TR_Tracking").

Надеюсь, это имеет смысл и, надеюсь, не слишком сложное в логике.

EDIT: EDIT: Я смог вычислить этот вариант. Я использовал следующий код ниже, чтобы выполнить раздел редактирования выше.

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

Попробуйте это (UNTESTED)

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