vba从定义的循环复制并粘贴到集合单元格中

我正在处理一个业务案例，其中有越来越多的场景，我可以在scenario manager中完成所有这些，但现在不方便

我试图做的是：我有一个给定场景的名称列表，这些名称应该粘贴到一个输入字段，然后运行场景，结果应该复制到为该场景指定的位置

目前的代码没有任何问题，但我觉得它“缓慢”，因为我需要为每个场景生成不同的代码块：

    Sheets("Output").Select
Range("G7").Select
ActiveCell.FormulaR1C1 = "All stores"
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("Output").Select
Range("G7").Select
ActiveCell.FormulaR1C1 = "Quartile 1"
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

其中G7是场景的位置，本例中的“所有存储”是第一个场景，N4:N18是该场景的结果，C4是这些结果的位置，下一个场景的结果粘贴到D4中

我尝试使用以下代码创建要粘贴到G7中的列表，但不起作用：

    Set ListScenarios = ActiveWorkbook.Sheets("RefTables").Range("B3:B11")

For Each cell In ListScenarios
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("G7").Select
ActiveSheet.Paste

Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Call Paste
Next cell

    Sub Paste()

Set Destination = ActiveWorkbook.Sheets("Stuurgroep").Range("C4:K4")
For Each cell In Destination
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Next cell

---

非常感谢您的帮助

那么你是想把一系列单元格复制到一个新的区域？不完全是，我想让宏一个接一个地运行该区域内的场景，然后在一系列单元格中每次运行后粘贴结果。保留每次运行的结果。主要是由于。选择..导致运行缓慢。使用With语句来处理工作表。谢谢，但这并不能解决是否需要编写多个代码块的主要问题，我将在余下的代码中使用With语句！