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 

---

我编辑使用您的代码将专门为我想，我现在明白你做了什么，但有一点我很难想象的结果应该是什么样子。如果这是不对的，我觉得好像我需要看看你的结果应该是什么样子，然后我才能再次尝试。