macros直到循环从值列表复制粘贴到单个单元格（例如b1）
这是我在这里的第一篇文章，以便你提前帮助你。 多么伟大的社区！
我正在尝试编写一个macros，它将通过未确定数量的行的值列表循环，并逐个将其复制并粘贴到单个单元格中，每次通过循环replace刚刚粘贴到单个单元格中的值，它由报告模板引用，并根据数字的id自动填充数据
以下是表格的一个例子：
__|__A__|__B__ 1 | 231 | 234 2 | 232 | 3 | 233 | 4 | 234 | 5 | 235 | 6 | 236 | 231将被复制并粘贴到B1中，然后将232复制并粘贴到B1中，然后将233复制并粘贴到B1中，然后将234复制并粘贴到B1中，等等等等。 在复制和过去的步骤之间，还有其他步骤将图像添加到工作表并保存为PDF。
我写了这个脚本来完成目标：
Sub Report() ' ' Report Macro ' ' Keyboard Shortcut: Ctrl+Shift+G ' ' this section just copies a selection of cells from on worksheet and moves it to another worksheet filters it and copies filtered list to yet another worksheet. Application.ScreenUpdating = False Selection.Copy Sheets("Master Sheet").Select Range("A6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Range("$A$5:$BS$410").AutoFilter Field:=7, Criteria1:="2" Selection.Copy Sheets("Report").Select Range("A1").Select ActiveSheet.Paste ' This section does the operation outlined at beginning of post. Range("A1").Select Do Until IsEmpty(ActiveCell.Value) Selection.Copy Range("B1").Select ActiveSheet.Paste Application.Run "PERSONAL.XLSB!ErasePhoto" Application.Run "PERSONAL.XLSB!PhotoPlace" ActiveWindow.ScrollRow = 1 Application.CutCopyMode = False ChDir "C:" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("B3").Value _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=True Application.Run "PERSONAL.XLSB!ErasePhoto" ActiveCell.Offset(1, 0).Select Loop End Sub
当我运行macros时，它通过一次成功，但不循环。 我不知道为什么？ 谢谢！！！！
循环执行代码以查看哪些单元格是活动单元格？ 代码将B1设置为每个循环中的活动单元格。 在不知道被调用的过程是什么的情况下，很难判断哪个单元受到了ActiveCell.Offset(1, 0).Select影响。
代码有很多不必要的select和激活语句。 清理。
好的，所以我可以从一个名叫skywriter的非常善良的人在excel论坛上find答案。 它像一个魅力工作。
Dim r As Range For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp)) Range("B1").Value = r.Value Application.Run "PERSONAL.XLSB!ErasePhoto" Application.Run "PERSONAL.XLSB!PhotoPlace" ActiveWindow.ScrollRow = 1 Application.CutCopyMode = False ChDir "C:" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("B3").Value _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=True Application.Run "PERSONAL.XLSB!ErasePhoto" Next r
我通过添加一个countervariables，然后在Do Until循环中使用，对代码做了一些小改动。 这使您可以使用“ Offsetselect所需的单元格。
' This section does the operation outlined at beginning of post. Range("A1").Select Dim counter As Long '---->line added counter = 1 '---->line added Do Until IsEmpty(ActiveCell.Value) Selection.Copy Range("B1").Select ActiveSheet.Paste Application.Run "PERSONAL.XLSB!ErasePhoto" Application.Run "PERSONAL.XLSB!PhotoPlace" ActiveWindow.ScrollRow = 1 Application.CutCopyMode = False ChDir "C:" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("B3").Value _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=True Application.Run "PERSONAL.XLSB!ErasePhoto" ActiveCell.Offset(counter, -1).Select '----> make change here counter = counter + 1 '----> line added Loop