Цикл Excel VBA Macro копирует ячейки на новый лист

Question

Новое в VBA, мне нужно создать какую-то программу, чтобы закодировать код, который я уже создал. Мне нужно, чтобы это происходило столько раз, сколько в столбце A. Есть переменные, которые будут меняться: от A1 до A2, от B1 до B2, от C1 до C2 и поэтому строка 2 скопирует тег (2) рабочего листа, затем A3, B3 и C3 в тег (3) и т. Д. Заранее спасибо.

Sub Copy1() 

    Do 
    Worksheets("WIP_List").Range("A1").Copy _ 
    Destination:=Worksheets("Tag (1)").Range("A7:I12") 
    Loop Until IsEmpty(ActiveCell.Offset(0, 1)) 

    Do 
    Worksheets("WIP_List").Range("B1").Copy _ 
    Destination:=Worksheets("Tag (1)").Range("A24:I28") 
    Loop Until IsEmpty(ActiveCell.Offset(0, 1)) 

    Do 
    Worksheets("WIP_List").Range("C1").Copy _ 
    Destination:=Worksheets("Tag (1)").Range("D19:F23") 
    Loop Until IsEmpty(ActiveCell.Offset(0, 1)) 

End Sub 

Edit:

Надеется, что это будет лучше объяснить, что я хочу сделать это, но без того, чтобы скопировать эти 200 раз, я хочу, чтобы петли до тех пор, пока теперь больше данных в столбце А

Sub Копирование1()

Worksheets("WIP_List").Range("A1").Copy _ 
Destination:=Worksheets("Tag (1)").Range("A7:I12") 

Worksheets("WIP_List").Range("B1").Copy _ 
Destination:=Worksheets("Tag (1)").Range("A24:I28") 

Worksheets("WIP_List").Range("C1").Copy _ 
Destination:=Worksheets("Tag (1)").Range("D19:F23") 

Worksheets("WIP_List").Range("A2").Copy _ 
Destination:=Worksheets("Tag (2)").Range("A7:I12") 

Worksheets("WIP_List").Range("B2").Copy _ 
Destination:=Worksheets("Tag (2)").Range("A24:I28") 

Worksheets("WIP_List").Range("C2").Copy _ 
Destination:=Worksheets("Tag (2)").Range("D19:F23") 

Worksheets("WIP_List").Range("A3").Copy _ 
Destination:=Worksheets("Tag (3)").Range("A7:I12") 

Worksheets("WIP_List").Range("B3").Copy _ 
Destination:=Worksheets("Tag (3)").Range("A24:I28") 

Worksheets("WIP_List").Range("C3").Copy _ 
Destination:=Worksheets("Tag (3)").Range("D19:F23") 

Worksheets("WIP_List").Range("A4").Copy _ 
Destination:=Worksheets("Tag (4)").Range("A7:I12") 

Worksheets("WIP_List").Range("B4").Copy _ 
Destination:=Worksheets("Tag (4)").Range("A24:I28") 

Worksheets("WIP_List").Range("C4").Copy _ 
Destination:=Worksheets("Tag (4)").Range("D19:F23") 

End Sub

Answer 1

Я думаю, я понимаю вашу Qu estion и продолжать цикл до тех пор, пока данные не будут очищены, вы хотите увеличить, пока значение не будет пустым. Использование функции IsEmpty и настройка поиска по 1 для каждой строки.

Dim xlwsStatic As Excel.Worksheet 
Dim xlwsTemp As Excel.Worksheet 
Dim i As Integer 

Set xlwsStatic = ActiveWorkbook.Worksheets("WIP_List") 'assigning worksheet to xlws 

i = 1 'initial value of i 


Do While IsEmpty(xlwsStatic.Range("A" & i).Value) = False 'loops through 


    Set xlwsTemp = ActiveWorkbook.Worksheets("Tag (" & i & ")") 

    xlwsStatic.Range("A" & i).Copy _ 
    Destination:=xlwsTemp.Range("A7:I12") 

    xlwsStatic.Range("B" & i).Copy _ 
    Destination:=xlwsTemp.Range("A24:I28") 

    xlwsStatic.Range("C" & i).Copy _ 
    Destination:=xlwsTemp.Range("D19:F23") 


    i = i + 1 'increments i up one per loop increasing the row and changing xlwsTemp 
Loop 

---

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