Excel VBA复制和粘贴循环内的循环

Question

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.

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.

Here's the logic I'm attempting: 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.

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.

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.

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.

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.

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!

Sub copyTest3()

Dim proj As Range, release As Range, pm As Range, lead As Range, coord As Range
Dim leadCopy As Range, coordCopy As Range
Dim i As Range

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

Set leadCopy = Union(pm, release, proj, lead)
Set coordCopy = Union(pm, release, proj, coord)


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

    Application.CutCopyMode = False

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

Next i

End Sub

Answer 1

The way I usually approach copying data between sheets in Excel is to create source range and destination range objects, each range referring to just one row. When I want to move on to the next row, I use Offset to return a range offset to the next row.

Since the ranges only refer to one row, you can index them with an integer to get the cells in the row. Eg if cursor refers to columns A through D in row 3, cursor(3) will give you the cell C3.

Dim src_cursor As Range
Dim dest_cursor As Range

Set src_cursor = ActiveSheet.Range("A3:I3")
Set dest_cursor = Sheets("Sheet2").Range("A2:D2")

'' Loop until column A is empty in source data
Do Until IsEmpty(src_cursor(1))
    dest_cursor(1) = src_cursor(6) '' copy F -> A
    dest_cursor(2) = src_cursor(4) '' copy D -> B
    '' and so on

    '' move cursors to next row
    Set src_cursor = src_cursor.Offset(1, 0)
    Set dest_cursor = dest_cursor.Offset(1, 0)
Loop

Also, this might be getting a little off topic, but it's a better practice to use an Enum to name the column numbers instead of hardcoding them like I did here.

Answer 2

There are many ways to do this, and some are more efficient than others. My solution may not be the most efficient, but hopefully it will be easy for you to understand so that you can learn.

It's very difficult to understand what you're attempting to do in activity three, so I wasn't able to provide a solution to that step. Use my code as a template for step three and if you run into issues, feel free to leave a comment.

Notice that I don't use .Activate , .Select , or .Copy in this code. .Activate and .Select are huge efficiency killers, and they make it easier for your code to "break," so avoid using them when possible. .Copy isn't necessary when working with values or formulas and will also slow your code down.

Untested

Sub testLoopPaste()

Dim i As Long
Dim ii As Long
Dim i3 as Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet

Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Sheet1")
Set sht2 = wb.Sheets("Sheet2")

'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
ii = 2

'This is the beginning of the loop
For i = 3 To LastRow
    'First activity
    sht2.Range("A" & ii) = sht1.Range("F" & i).Value
    sht2.Range("B" & ii) = sht1.Range("D" & i).Value
    sht2.Range("C" & ii) = sht1.Range("A" & i).Value
    sht2.Range("D" & ii) = sht1.Range("H" & i).Value
    ii = ii + 1

    'Second activity
    sht2.Range("A" & ii) = sht1.Range("F" & i).Value
    sht2.Range("B" & ii) = sht1.Range("D" & i).Value
    sht2.Range("C" & ii) = sht1.Range("A" & i).Value
    sht2.Range("D" & ii) = sht1.Range("I" & i).Value
    ii = ii + 1

    'Third activity
    For i3 = 1 To sht1.Range("K" & I)  
        sht2.Range("A" & ii) = sht1.Range("F" & i).Value  
        sht2.Range("B" & ii) = sht1.Range("D" & i).Value  
        sht2.Range("C" & ii) = sht1.Range("A" & i).Value  
        ii = ii + 1  
    Next i3

Next i

End Sub