Excel VBA-复制、粘贴，然后移动到下一行，直到达到空白

基本上，我有三列数据和一个单独的选项卡上的模型。“数据”选项卡有1000行数据，每个条目将在模型中运行，结果将粘贴到第四列

下面是一次迭代的样子，但我需要它在每一行中循环

Worksheets("Data").Range("E2:G2").Copy _ 
Worksheets("Model").Range("B4:D4").PasteSpecial Paste:=xlPasteValues

Calculate

Worksheets("Model").Range("C120").Copy_
Worksheets("Data").Range("H2").PasteSpecial Paste:=xlPasteValues

Worksheets("Model").Range("C121").Copy_
Worksheets("Data").Range("I2").PasteSpecial Paste:=xlPasteValues

Worksheets("Model").Range("C122").Copy_ 
Worksheets("Data").Range("J2").PasteSpecial Paste:=xlPasteValues

然后我们将从数据选项卡复制下一行数据（即范围E3:G3）

---

这似乎是一个经典的循环场景，但我不知道如何在VBA中编写它

这是一个简单的循环，用于查找“数据”中的最后一行，并将其用于“模型”中定义的循环

这样做的预期结果是，循环将从第120行开始，一直持续到“数据”中的最后一行，将数据从C120复制到C（lRow），并将其粘贴到“数据”表中

---

最好的方法是使用cells函数，其中第一个参数是行，第二个参数是列。由于您希望将源一次复制一行，但将粘贴目标一次增加一列，因此此方法将是合适的

此外，尽量不要使用“复制粘贴”，重点是通过引用要复制的源中的值属性来设置单元格的值。每次复制并粘贴到目标时，都需要一个额外的内存单元，如果要复制的范围很大，则需要更长的时间

下面的代码应该可以完成这项工作

Sub CopyData()
    Dim i As Integer
    i = 8 ' Start pasting into column H
    ' Loop until a blank cell is found
    Do While Not Selection.Value = 0
        With Sheets("Data").Cells(i + 112, 3)
            ' Select each cell in "Data", starting on C120
            .Select
            ' Copy the value into "Model", starting on H2
            Sheets("Model").Cells(2, i).Value = .Value
        End With
    Loop
End Sub

---

您可以在一个范围内执行此操作，我认为有两种方法可以执行此操作，即使用复制粘贴或简单地复制数据的转置版本：

'Copy and paste method
Worksheets("Model").Range("C120:C" & range("C" & rows.count).end(xlup).row).Copy 'Using the .end(xlup) will find the last row of data without looping until blank.
Worksheets("Data").Range("H2").PasteSpecial xlPasteValues,,,True 'The True here is what tells the pastespecial to transpose

'Transpose method
Worksheets("Data").Range("H2:J2").Value = application.transpose(Worksheets("Model").range("C120:C122"))

每种方法都有各自的优点，复制和粘贴方法更容易，因为您不需要知道结束列，因此在动态范围内工作更容易；转置方法不使用剪贴板，因此对系统的影响更小

在代码方面更好的方法是转置方法

然后，您可以为下一个循环设置一个简单的

，以在任意多个数据范围内运行

Dim DataRow As Long, MyDat As Worksheet, MyModel As Worksheet
Set MyDat = Worksheets("Data")
Set MyModel = Worksheet("Model")
For DataRow = 2 To MyDat.Range("E" & Rows.Count).End(xlUp).Row
    MyModel.Range("B4:D4").Value = MyDat.Range("E" & DataRow & ":G" & DataRow).value
    Calculate
    MyDat.Range("H" & DataRow & ":J" & DataRow).Value = Application.Transpose(MyModel.Range("C120:C122"))
Next

旁注：删除那些行连续体<代码>.

不应该在这个代码段的任何地方，因为

Copy

是一行，

PasteSpecial

是一行新的。为什么不试试呢？循环中有很多内容。另外，因为您只需要值，而不需要格式化/公式等。您可以将范围设置为相等，而不是使用

。复制
：
范围（[destination Range]）。值=范围（[original data Range]）。值
。另外，您可以添加一些示例数据。不清楚您是否要运行模型，复制结果，然后再次运行模型并复制相同的结果范围，或者您是否有一张包含多个结果集的工作表，这些结果集由一个空格分隔。请阅读上面BruceWaynes关于设置值而不是使用复制/粘贴值的帖子。您不能执行
srcws.Cells（1,3）.复制
（与目的地相同）？另外，如果您保留
Range（）
，您还需要在工作表中限定
单元格（）
。关于限定
单元格（）
。如果在外部调用引用，您需要吗？即：
srcws.Range（单元格（1,3））
与表示
srcws.Range（“C1”）的意思相同
。使用.select是一种糟糕的方法。它占用大量资源，不推荐使用。循环应该是最后一种方法。不幸的是，由于数据的动态性质，我不得不编辑代码以引入循环，因为数据具有多个大小不等的范围组，但我认为这将是一种不错的速度，肯定比在ti上做一行要好得多我。我第一次没有正确地阅读这个问题，这就是为什么我认为它可以在没有循环的情况下完成
Dim DataRow As Long, MyDat As Worksheet, MyModel As Worksheet
Set MyDat = Worksheets("Data")
Set MyModel = Worksheet("Model")
For DataRow = 2 To MyDat.Range("E" & Rows.Count).End(xlUp).Row
    MyModel.Range("B4:D4").Value = MyDat.Range("E" & DataRow & ":G" & DataRow).value
    Calculate
    MyDat.Range("H" & DataRow & ":J" & DataRow).Value = Application.Transpose(MyModel.Range("C120:C122"))
Next