Excel VBA中的复制和粘贴循环 | VBA中的复制和粘贴循环

本文介绍了Excel VBA中的复制和粘贴循环的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我一直在使用这个VBA代码一段时间，因为我是一个完整的noob，我觉得我没有任何地方。我一直在研究一吨，但似乎并没有结合答案来帮助我的场景。

本质上我要做的是抓数据，行一行，从一个工作表，并将其推断到另一个工作表。我相信这将涉及循环，我是VBA新的，我不知道该怎么做。

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

第一个活动是复制单元格F3，D3，A3和H3（按此顺序，F3将A2，D3将B2等）从纸张1到纸张2到A2，B2，C2等。目的地功能不能使用，因为我只需要值而没有其他格式 - 许多问题之一我'下一个活动是将单元格F3，D3，A3和I3从表格1复制到粘贴到上一个副本下方的粘贴，再次粘贴 - 再次没有格式只是价值观。还要注意，其中一些可能是空白的（A列除外），但是我仍然需要至少有一列A数据，这就是所有这些活动。

第三个活动是将sheet1的F3，D3和A3复制并粘贴一定次数，引用K3的号码，每次复制和粘贴都将在下一个可用的空白单元格中。所以如果K3中的数字看起来像在sheet2中创建了3行，在sheet2上共计5行，因为activity1和2都创建了自己的行。

活动将在第1页的第3行完成，然后移动到第4行，然后执行前三个活动并粘贴到sheet2。再次，它将粘贴没有格式，并在表2的下一个空白行中。同样，如果列A中的单元格为空，则此循环将停止。

下面是我的不完整的代码我甚至不认为这会有所帮助，甚至不要再看它。我刚刚开始感到沮丧，因为我甚至不能做一个简单的复制和粘贴，而是单独循环循环。我也没有开始我的第三个活动。我非常感谢！

  Sub copyTest3（）
 
 Dim proj As Range，Release As Range，作为范围，作为范围
 Dim leadCopy As Range，coordCopy As Range 
 Dim i As Range 
 
 Set proj = Range（A3，Range（ A3）结束（xlDown））
设置释放=范围（D3，范围（D3）。结束（xlDown））
设置pm =范围（F3 F3）结束（xlDown））
设置lead = Range（H3，Range（H3）。End（xlDown））
设置coord = Range（I3，Range I3）。End（xlDown））
 
设置leadCopy = Union（pm，release，proj，lead）
设置coordCopy = Union（pm，release，proj，coord）
 
 
对于i = 1到范围（ActiveSheet.Range（A3），ActiveSheet.Range（A3）。End（xlDown））
 leadCopy.Copy 
表单（Sheet2）。激活
范围（A2）。选择
 ActiveSheet.PasteSpecial xlPasteValues 
 
 Application.CutCopyMode = False 
 
表单（Sheet1）。激活
 coordCopy.Copy 
表单（Sheet2）。激活
 Ran ge（A2）。选择
 ActiveSheet.PasteSpecial xlPasteValues 
 
 Next i 
 
 End Sub

解决方案

有很多方法可以做到这一点，有些方法比其他方法更有效率。我的解决方案可能不是最有效率的，但希望您能够轻松了解，以便您学习。

很难理解您正在尝试的内容在活动三中做，所以我无法提供一个解决方案。使用我的代码作为第三步的模板，如果遇到问题，请随时发表评论。

请注意，我不使用。在此代码中激活，。选择或 .Copy 。 。激活和。选择是巨大的效率杀手，它们使您的代码更容易打破，所以尽可能避免使用它们。在使用值或公式时，不需要 .Copy ，也会减慢代码的速度。

未测试

  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 
 
设置wb = ThisWorkbook 
设置sht1 = wb.Sheets（Sheet1）
设置sht2 = wb.Sheets（ Sheet2）
 
'用数据查找最后一行（在A列）。 
 LastRow = sht1.Range（A：A）。Find（*，searchdirection = = xlPrevious）.Row 
 ii = 2 
 
'这是开始的循环
对于i = 3 To LastRow 
'第一个活动
 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 
 
'第二活动
 sht2.Range（A& ii）= sht1.Range（F& i）.Value 
 sht2.Range（B& ii） =sh （D& ii）= sht1.Range（I& i）.Value 
 ii = ii + 1 
 
'第三活动
对于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 
下一页i3 
 
下一页i 
 
结束Sub

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

解决方案

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

这篇关于Excel VBA中的复制和粘贴循环的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！