Excel循環VBA宏複製單元格到新工作表

Question

VBA新手，我需要創建一些程序來循環我已經創建的代碼。 我需要這種情況發生的次數與列A中的數據一樣多。將改變的變量是A1到A2，B1到B2，C1到C2，因此第2行將複製到工作表Tag（2），然後是A3， B3和C3到Tag（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 

編輯：

希望這將更好地解釋，我想這樣做，但不必複製這個200倍，我希望它循環，直到有列現在更多的數據A

子副本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") 

末次

Answer 1

我想我明白你的曲並保持循環，直到數據清晰，你會想要增加值，而不是空白。使用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 

---

我編輯使用您的代碼將專門爲我想，我現在明白你做了什麼，但有一點我很難想象的結果應該是什麼樣子。如果這是不對的，我覺得好像我需要看看你的結果應該是什麼樣子，然後我才能再次嘗試。