VBA 如何使用单值复制/粘贴和偏移创建数据验证循环

Question

我想创建一个循环遍历数据验证列表的宏，该列表位于名为 Gym Weekly Template 的工作表的单元格 C8 中。对于数据验证列表中的每个值（该列表由来自工作表“测试数据”的范围 A6:A45 的数据组成），我有一个在同一工作表的单元格 W73 中生成的 vlookup 值.

我想将单元格 W73 中的每个值粘贴到名为 Gym Load Monitoring 的新工作表中，该工作表从单元格 B2 开始，一直向下到 B 列，一旦数据验证列表循环通过，就结束宏。 如果可能的话，如果我要再次运行宏，我希望它能够识别工作表 Gym Load Monitoring 的列 B 中有数据，并将值粘贴到下一个空白列中，依此类推，宏运行。 我已经编写了当前代码，但我感觉我完全偏离了轨道：

Sub PasteLoads()
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long


'Which cell has data validation
Set dvCell = Worksheets("Gym Weekly Template").Range("C8")

'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)

i = 1
Application.ScreenUpdating = False
For Each c In inputRange
    dvCell = c.Value

    With Worksheets("Gym Load Monitoring")
        ThisWorkbook.Sheets("Gym Weekly Template").Range("W73").Copy.Range("B" & .Rows.Count).End (xlUp)

Next c
Application.ScreenUpdating = True


End Sub

我对 VBA 编码不是很有经验，所以这可能是错误的。我知道我需要添加 Offset 但不确定在哪里。

Answer 1

添加了一些额外的变量以减少重复，并检查以确保每次运行 Sub 时写入一个空列。

未经测试：

Sub PasteLoads()
    Dim shtGWT As Worksheet, shtGLM As Worksheet
    Dim dvCell As Range
    Dim inputRange As Range, resultRange As Range
    Dim c As Range
    Dim i As Long, nextCol As Long


    Set shtGWT = Worksheets("Gym Weekly Template")
    Set shtGLM = Worksheets("Gym Load Monitoring")

    'Which cell has data validation
    Set dvCell = shtGWT.Range("C8")
    Set resultRange = shtGWT.Range("W73")

    'Determine where validation comes from
    Set inputRange = Evaluate(dvCell.Validation.Formula1)

    nextCol = 2
    'find an empty column
    Do While Application.CountA(shtGLM.Cells(2,nextCol).Resize(500, 1)) > 0
        nextCol = nextCol + 1
    Loop

    i = 2
    Application.ScreenUpdating = False
    For Each c In inputRange.Cells
        dvCell.Value = c.Value
        shtGLM.Cells(i, nextCol).Value = resultRange.Value
        i = i + 1
    Next c
    Application.ScreenUpdating = True


End Sub