直到循环暂停

Question

我正试图使用"Do Until"循环从列表(下拉字段工作表，从单元格B19开始(中获取一个值，并更新另一个Excel工作表(特别是数据收集工作表，单元格C1(中的一个单元格值。一旦我能做到这一点，我将添加已经运行的代码，根据数据收集工作表中C1的值来保存文件。

我正在测试代码，但在提取第一个值后，它总是被卡住。基本上，直到列表结束，它才真正在列表中循环。

我认为这与什么是活性细胞有关。我认为粘贴值时会更改活动单元格。我试图通过再次迭代活动单元格来纠正这一问题。不过，这可能会创建一个无限循环。

我能做些什么来调整一下吗？提前感谢您查看此以及您可能收到的任何回复！我的结构基于https://learn.microsoft.com/en-us/office/troubleshoot/excel/loop-through-data-using-macro

以下代码：

Sub Test2()
' Select cell to start loop, *first line of data*.
Worksheets("Drop-down fields").Activate
Range("B19").Select
Worksheets("Drop-down fields").Range("B19").Copy
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Worksheets("Data Collection").Range("C1").PasteSpecial Paste:=xlPasteValues
Worksheets("Drop-down fields").Activate
Range("B19").Select
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Answer 1

Samuel，

以下是您的代码经过重构，删除了B列中的所有激活、选择和递增，并复制到C列。

Sub Test2()

Dim wksSrc  as Worksheet
Dim wksDst  as Worksheet
Dim lSrcRow as Long
Dim lDstRow as Long

Set wksSrc = Worksheets("Drop-down fields")
Set wksDst = Worksheets("Data Collection")
lSrcRow = 19
lDstRow = 1

Do 
wksSrc.cells(lSrcRow,2).Copy
wksDst.Cells(lDstRow,3).PasteSpecial Paste:=xlPasteValues
lSrcRow = lSrcRow + 1
lDstRow = lDstRow + 1
Loop Until wksSrc.cells(lSrcRow,lSrcCol) = ""

End Sub 'Test2

注意：代码未经测试，但我认为我得到了所有正确的引用。HTH-