VBA 如何创建具有单值复制/粘贴和偏移量的数据验证循环

Question

我想创建一个宏，该宏循环访问我位于名为"健身房每周模板"工作表上的单元格 C8 中的数据验证列表。对于数据验证列表中的每个值(该列表由工作表"测试数据"中范围 A6：A45 中的数据组成(，我有一个在同一工作表的单元格W73中生成的 vlookup 值。

我想将单元格W73中的每个值粘贴到名为 Gym 负荷监控的新工作表中，从单元格B2开始，沿着B列向下，在数据验证列表循环遍历后结束宏。 如果可能，如果我要再次运行宏，我希望它识别工作表 Gym 负载监控的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 编码不是很有经验，所以这可能是错误的。我知道我需要添加偏移量，但不确定在哪里。

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