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

Excel VBA Copy and Paste Loop within Loop

提问by blasibr

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.

我已经在这个 VBA 代码上工作了一段时间，因为我是一个完整的菜鸟，所以我觉得我什么都没有。我一直在研究一吨，但似乎无法结合答案来帮助我的场景。

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.

本质上，我要做的是从一个工作表中逐行抓取数据并将其外推到另一个工作表。我相信这将涉及循环，而且我对 VBA 很陌生，我不知道该怎么做。

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.

这是我正在尝试的逻辑：对于工作表 1 上的每一行，我想对工作表 2 执行 3 个不同的复制和粘贴活动，然后它将循环到工作表 1 上的下一行并执行 3 个活动，依此类推。这将继续向下，直到表 1 中的 A 列为空白。Sheet1 数据从 A3 开始，sheet2 粘贴区域从 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.

第一个活动是将单元格 F3、D3、A3 和 H3（按此顺序，因此 F3 将是 A2，D3 将是 B2 等）从工作表 1 复制到工作表 2 到 A2、B2、C2 等。目标函数可以不使用，因为我只需要值而不需要其他格式——这是我遇到的众多问题之一。

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.

下一个活动是将单元格 F3、D3、A3 和 I3 从工作表 1 复制到粘贴在先前复制和粘贴下方的工作表 2 — 同样没有格式只是值。还要注意的是，其中一些可能是空白的（A 列除外），但我仍然需要该行至少包含 A 列数据——这与所有这些活动有关。

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.

第三个活动是参考 K3 的编号将 sheet1 的 F3、D3 和 A3 复制和粘贴一定次数 - 每次复制和粘贴都将位于下一个可用的空白单元格中。因此，如果 K3 中的数字看起来像是在 sheet2 中创建了 3 行 - 因为活动 1 和 2 各自创建了自己的行，因此在 sheet2 上总共有 5 行。

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.

在工作表 1 的第 3 行完成这三个活动后，它将移动到第 4 行并执行前三个活动并粘贴到工作表 2。再次，它将不粘贴任何格式，并粘贴到工作表 2 的下一个空白行中。同样，一旦 A 列中的单元格为空白，此循环将停止。

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

采纳答案by ARich

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.

很难理解您在活动 3 中尝试做什么，因此我无法提供该步骤的解决方案。使用我的代码作为第三步的模板，如果您遇到问题，请随时发表评论。

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

请注意，我没有在此代码中使用.Activate, .Select, 或.Copy。.Activate并且.Select是巨大的效率杀手，它们使您的代码更容易“中断”，因此请尽可能避免使用它们。.Copy在处理值或公式时不是必需的，并且还会减慢您的代码速度。

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

回答by Tmdean

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 Offsetto return a range offset to the next row.

我通常在 Excel 中的工作表之间复制数据的方法是创建源范围和目标范围对象，每个范围只引用一行。当我想移到下一行时，我使用Offset返回到下一行的范围偏移量。

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

由于范围仅引用一行，您可以使用整数索引它们以获取行中的单元格。例如，如果cursor引用第 3 行中的 A 列到 D 列，cursor(3)则会为您提供单元格 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 Enumto name the column numbers instead of hardcoding them like I did here.

此外，这可能有点偏离主题，但更好的做法是使用 anEnum来命名列号，而不是像我在这里所做的那样对它们进行硬编码。