VBA Copy and Paste Loop within Loop, help!

[blasibr]

Hello, I’ve been working on this VBA code for a while and since I’m a complete noob I feel like I haven’t gotten anywhere. I’ve been researching a ton, but can’t seem to combine answers to help with my scenario.</SPAN>

Essentially what I’m trying to do is grab data, line by line, from one worksheet and extrapolate it to another worksheet. I believe this will involve loops and I’m so new with VBA I don’t know how to do it. </SPAN>

Here’s the logic I’m attempting:</SPAN>
For each row on worksheet 1, I would like to perform 3 different copy and paste activities to worksheet 2 and then it will loop down to the next row on sheet1 and do the 3 activities and so on. This will continue downwards until column A is blank in sheet1. Sheet1 data starts at A3 and sheets2 paste area starts at A2.</SPAN>

The first activity is to copy cells F3,D3,A3, and H3 (in that order so F3 will be A2, D3 will be B2 etc) from sheet 1 to sheet 2 to A2,B2,C2, etc. A destination functions can’t be used because I need just the values and no other formats—one of the many issues I’ve ran in to.</SPAN>

The next activity is to copy cells F3,D3,A3 and I3 from sheet 1 to sheet2 pasted below the previous copy and paste—again no formats just values. Also to note, some of these may be blank (except A column) but I still need that row there with at least column A data—this goes to say with all these activities.</SPAN>

The third activity is to copy and paste sheet1’s F3,D3, and A3 a certain number of times referencing K3’s number—and each copy and paste will be in the next available blank cell. So if the number in K3 it will look like it created 3 rows in sheet2—totaling 5 rows on sheet2 since activity1 and 2 each create their own row.</SPAN>

After these three activities are completed for row 3 on sheet 1, it will then move to row 4 and do the previous three activities and paste to sheet2. And again it will be pasting no formats and in the next blank row on sheet 2. Also again, this loop will stop once the cell in Column A is blank.</SPAN>

Below is my incomplete code. I don’t even think it will help one bit and it would probably be better not to even look at it. I’ve just started to get frustrated since I can’t even do a simple copy and paste, yet alone loops within loops. I also haven’t even started on my third activity. I greatly appreciate it!</SPAN>

Sub copyTest3()</SPAN>

Dim proj As Range, release As Range, pm As Range, lead As Range, coord As Range</SPAN>
Dim leadCopy As Range, coordCopy As Range</SPAN>
Dim i As Range</SPAN>

Set proj = Range("A3", Range("A3").End(xlDown))</SPAN>
Set release = Range("D3", Range("D3").End(xlDown))</SPAN>
Set pm = Range("F3", Range("F3").End(xlDown))</SPAN>
Set lead = Range("H3", Range("H3").End(xlDown))</SPAN>
Set coord = Range("I3", Range("I3").End(xlDown))</SPAN>

Set leadCopy = Union(pm, release, proj, lead)</SPAN>
Set coordCopy = Union(pm, release, proj, coord)</SPAN>

For i = 1 To Range(ActiveSheet.Range("A3"), ActiveSheet.Range("A3").End(xlDown))</SPAN>
    
    leadCopy.Copy</SPAN>
    Sheets("Sheet2").Activate</SPAN>
    Range("A2").Select</SPAN>
    ActiveSheet.PasteSpecial xlPasteValues</SPAN>

    Application.CutCopyMode = False</SPAN>

    Sheets("Sheet1").Activate</SPAN>
    coordCopy.Copy</SPAN>
    Sheets("Sheet2").Activate</SPAN>
    Range("A2").Select</SPAN>
    ActiveSheet.PasteSpecial xlPasteValues</SPAN>

Next i</SPAN>

End Sub

</SPAN>

 

[btomjack]

Firstly, in your "third activity", what role does cell K3 play? You say that it checks the value of that cell, but you don't specify what the criteria or results are. Say, for example, that the value in K3 is some number #. Are you saying that the code should perform the copy operation # number of times, or is there some other criteria?

Also, have you tried using macro recorder? If you're using Excel 2010, it's under the "View" tab; click on the down arrow under the "Macros" button, and a menu should pop up allowing you to choose macro recorder. Perform some of the actions you need, then click "Stop recording" (in the same locations as the "Record macro" button that started the recording. This should help you in the future, at least as a guideline for getting your code started.

 

[blasibr]

Hello btomjack! That is correct, the number in column K will be the number of times a copy operation is performed. Essentially it will be the number of rows that will be created in sheet2 that have columns A,B, and C filled out, D will be blank that I will manually fill out later. And I did in fact start with a macro recorder which didn't get me anywhere, so then I started morphing code from other users which really didn't get me anywhere either. I've tried attacking this problem from a lot of different ways but I've come to realize I just don't know the most efficient nor the correct way to do it.

 

[blasibr]

I was able to get an answer here! Excel VBA Copy and Paste Loop within Loop - Stack Overflow

 

[btomjack]

That's a shame; I just came up with this:

Sub MultiCopy()

Dim MyWorkbook As Workbook
Dim MySheet1 As Worksheet, MySheet2 As Worksheet
Dim i As Integer, n As Integer, t As Integer, q As Integer, RowCount As Integer


Set MyWorkbook = Application.ActiveWorkbook
Set MySheet1 = MyWorkbook.Worksheets("Sheet1")
Set MySheet2 = MyWorkbook.Worksheets("Sheet2")


i = 3
n = 1
t = 2
q = 1
RowCount = WorksheetFunction.CountIf(MySheet1.Range("A:A"), "*")


Do While n <= RowCount


    MySheet1.Activate
    MySheet1.Cells(i, 6).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    MySheet1.Activate
    MySheet1.Cells(i, 4).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    MySheet1.Activate
    MySheet1.Cells(i, 1).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    MySheet1.Activate
    MySheet1.Cells(i, 8).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    t = t + 1
    
    MySheet1.Activate
    MySheet1.Cells(i, 6).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    MySheet1.Activate
    MySheet1.Cells(i, 4).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    MySheet1.Activate
    MySheet1.Cells(i, 1).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    MySheet1.Activate
    MySheet1.Cells(i, 9).Select
    Selection.Copy
    MySheet2.Activate
    MySheet2.Cells(t, 4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False
    
    t = t + 1
    
    If MySheet1.Cells(i, 11).Value > 0 Then
        Do While q <= MySheet1.Cells(i, 11).Value
            MySheet1.Activate
            MySheet1.Cells(i, 6).Select
            Selection.Copy
            MySheet2.Activate
            MySheet2.Cells(t, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
            Application.CutCopyMode = False
    
            MySheet1.Activate
            MySheet1.Cells(i, 4).Select
            Selection.Copy
            MySheet2.Activate
            MySheet2.Cells(t, 2).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
            Application.CutCopyMode = False
    
            MySheet1.Activate
            MySheet1.Cells(i, 1).Select
            Selection.Copy
            MySheet2.Activate
            MySheet2.Cells(t, 3).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
            Application.CutCopyMode = False
            
            t = t + 1
            q = q + 1
        Loop
    End If
        
    i = i + 1
    n = n + 1
    q = 1
    
Loop


End Sub

Obviously, the cell references & sheet names will have to change, but that works as intended.