嵌套'每个'循环下拉和复制粘贴

时间:2017-10-03 15:46:26

标签: excel vba loops nested each

第一篇文章 - 请原谅我的天真。

我试图在下拉列表中循环遍历我的所有值,其源代码位于表格" Comm O& S",范围A31:L31。我想从下拉列表中的选择中复制另一个工作表中的值,并将这些值粘贴到单独工作表的列中(从C列开始)。然后,我想在下拉列表中选择下一个值并将下一列中的值复制粘贴,等等。

我似乎无法在下拉循环中嵌套复制粘贴。我的代码如下。我感谢你的帮助和宽恕。

Sheets("Scenario by Payer").Activate
For Each rngCell In wb.Worksheets("Comm O & S").Range("A31:L31")
    ' Set the value of dd_comm
    ws.Range("D14").Value = rngCell.Value

    Sheets("Detailed Outputs").Select
    Range("T52:t60").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Comm O & S").Activate

    For Each c In ActiveSheet.Range("C7:L7").Cells
        c.Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False

    Next rngCell
Next c

1 个答案:

答案 0 :(得分:0)

尝试一下:

Sub tgr()

    Dim wb As Workbook
    Dim wsScen As Worksheet
    Dim wsComm As Worksheet
    Dim wsOuts As Worksheet
    Dim rDDList As Range
    Dim rDDCell As Range
    Dim rDDValue As Range
    Dim rCopy As Range
    Dim rDest As Range

    Set wb = ActiveWorkbook
    Set wsScen = wb.Sheets("Scenario")
    Set wsComm = wb.Sheets("Comm O & S")
    Set wsOuts = wb.Sheets("Detailed Outputs")

    Set rDDList = wsComm.Range("A31:L31")
    Set rDDValue = wsScen.Range("D14")
    Set rCopy = wsOuts.Range("T52:T60")
    Set rDest = wsComm.Range("C7")

    For Each rDDCell In rDDList.Cells
        rDDValue.Value = rDDCell.Value
        rDest.Resize(rCopy.Rows.Count, rCopy.Columns.Count).Value = rCopy.Value
        Set rDest = rDest.Offset(, rCopy.Columns.Count)
    Next rDDCell

End Sub