Excel loop VBA Macro copy cells to new sheet

Question

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

Edit:

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

End Sub

Tbaker · Accepted Answer · 2014-10-07T11:58:41.453

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.

I edited my question to hopefully further and better explain what I need. — Alex, Oct 06 '14 at 20:45
I think I see what you are driving at, so I have edited my answer — Tbaker, Oct 07 '14 at 11:59

Excel loop VBA Macro copy cells to new sheet

1 Answers1

Linked