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 列中有更多数据

Sub 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

---

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