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

本文介绍了Excel将VBA宏复制单元格循环到新工作表的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

VBA的新增功能，我需要创建某种程序来循环已创建的代码.我需要这种情况发生的次数与A列中的数据一样多.要更改的变量是A1到A2，B1到B2，C1到C2，因此第2行将复制到工作表标签(2)，然后复制到A3，B3和C3标记(3)，依此类推.预先感谢.

New to VBA, I need to create some sort of program to loop the code I've already created.I need this to happen for as many times as there is data in column A. The variables that will change are A1 to A2, B1 to B2, C1 to C2 and so row 2 will copy to worksheet Tag (2) then A3, B3 and C3 to Tag (3) and so on. Thanks in advance.

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

Hopefully this will explain better, I want to do this but without having to copy this 200 times, I want it to loop until there is now more data in column 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")

结束子

推荐答案

我想我理解您的问题，并保持循环直到数据清除为止，您希望在值不为空的情况下递增.使用IsEmpty函数并将搜索结果的每一行调整为1.

I think i understand your question, and to keep looping until the data is clear you would want to increment while the value is not blank. Using the IsEmpty function and adjusting your search by 1 for each row.

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

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

I edited to use your code specifically as I think I now understand what you are getting at, but it is a little difficult for me to picture what the outcome should look like. If this isn't right I feel as though I would need to see what your outcome should look like before I could attempt again.

这篇关于Excel将VBA宏复制单元格循环到新工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！