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

我一直在这个VBA代码工作了一段时间，因为我是一个完整的noob我觉得我没有得到任何地方。 我一直在研究一吨，但似乎无法结合答案，以帮助我的情况。

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

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

第一个活动是将单元格F3，D3，A3和H3（依次为F3，A2为D3，D3为B2等）从表格1复制到表格2到A2，B2，C2等。不要使用，因为我只需要价值而不需要其他格式，这是我遇到的许多问题之一。

下一个活动是将单元格F3，D3，A3和I3从表单1复制到粘贴在前一个副本之下的表单2中，然后粘贴 – 不再有格式值。 另外要注意的是，其中一些可能是空白的（A列除外），但我仍然至less需要列A的数据 – 这就是所有这些活动。

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

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

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

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

有很多方法可以做到这一点，有些比其他更有效率。 我的解决scheme可能不是最有效率的，但是希望这个解决scheme对你来说很容易理解，这样你就可以学习。

在第三项活动中很难理解你想要做什么，所以我无法为这一步提供解决scheme。 使用我的代码作为第三步的模板，如果遇到问题，请随时发表评论。

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

未经testing

 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 

Answer 2

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

由于范围只能引用一行，因此可以使用整数对它们进行索引以获取行中的单元格。 例如，如果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 

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