Excel将VBA宏复制单元格循环到新工作表

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

编辑：

希望这可以更好地解释，我想这样做，但是不必复制200次，我希望它一直循环直到现在A列中有更多数据为止

子Copy1（）

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

---

我经过编辑以专门使用您的代码，因为我认为我现在已经了解了您的意思，但是我很难想象结果应该是什么样子。 如果这不正确，我觉得我需要先查看您的结果，然后再尝试。