时间戳

首页 > 解决方案 > VBA - 复制，粘贴然后移动到下一行直到到达空白

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

问题描述

本质上，我在三列中有数据，在单独的选项卡上有一个模型。数据选项卡有 1,000 行数据，每个条目将在模型中运行，结果将粘贴到第四列。

这是一次迭代的样子，但我需要它遍历每一行。

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 编写它。

标签： excelvbaloops

解决方案

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

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

Sub test()
    ' declare your variables so vba knows what it is working with
    Dim lRow, i As Long
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim srcws As Worksheet: Set srcws = wb.Worksheets("Data")
    Dim destws As Worksheet: Set destws = wb.Worksheets("Model")

    ' find the last row in Data
    lRow = srcws.Cells(srcws.Rows.Count, 1).End(xlUp).Row

    ' iterate from 120 to the last row found above
    For i = 120 To lRow
        ' copy /paste the data
        srcws.cells(1, 3).Copy Destination:=destws.cells(2, 7 + i)
    Next i
End Sub

推荐阅读