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

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")

End Sub

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

我编辑后专门使用你的代码，因为我觉得我现在明白了你的目标，但是我很难想象结果应该是什么样子。如果这不对，我觉得在我再次尝试之前我需要看看你的结果应该是什么样的。

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

1 个答案: