Код VBA для перебора выпадающего списка, а затем копирования / вставки диапазона для каждой итерации в новую вкладку

Question

У меня есть рабочий лист («Анализ») с выпадающим списком проверки, который имеет 5 вариантов. Раскрывающийся список находится в ячейке B6. Я хочу перебрать 5 опций в этом раскрывающемся списке, которые дают разные итоговые результаты, содержащиеся в диапазоне B10: N25, а затем скопировать значения в новый рабочий лист («Вывод»). Я хотел бы получить сводные результаты для каждой из этих 5 итераций на листе «Вывод», поэтому нужен код для обновления ячейки назначения на листе «Вывод» с каждым циклом, чтобы она не вставлялась в одну и ту же область. Спасибо!

Я пробовал пару вариантов VBA, но они были написаны для отдельных строк данных или для создания новых вкладок для каждой итерации.

Sub Iteration_Loop()
'
' Iteration_Loop Macro
' Loops through alternatives
'

' create variables
    Dim input As Range
    Dim c As Range

    Set input = Evaluate(Sheets("Analysis").Range("B6").Validation.Formula1)
    For Each c In input
    Calculate
    Sheets("Analysis").Range("B10:N25").Copy
    Sheets("Output Sheet").Range("C5").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=
    '    xlNone , SkipBlanks:=False, Transpose:=False

    Next c

End Sub

Я думаю, что это делает итерацию, но просто копирует в тот же диапазон в Output.

Answer 1

, хотя не мог ясно понять вопрос, предполагается, что ячейки назначения изменяются с итерацией (в противном случае он должен перекрывать ранее вставленную область). Я использовал его для копирования один под другим с блоком из 20 строк, как показано

. Input является ключевым словом в VBA и не может использоваться в качестве переменной.

Sub Iteration_Loop()
Dim Rng As Range
Dim c As Range
Dim DestRow As Long

     'Set Rng to the list of values in the validation list
Set Rng = Sheets("Analysis").Range(Sheets("Analysis").Range("B6").Validation.Formula1)
DestRow = 0

     For Each c In Rng.Cells
     Sheets("Analysis").Range("B6").Value = c.Value
     Application.Calculate
     Sheets("Analysis").Range("B10:N25").Copy
     Sheets("Output Sheet").Range("C" & DestRow + 5).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
     DestRow = DestRow + 20
     Next c

End Sub

Answer 2

Вот мое решение, включая комментарии в коде:

Sub t()

    'Input will give you an error
    Set Input_Analysis = Evaluate(Sheets("Analysis").Range("B6").Validation.Formula1)
    For Each Value In Input_Analysis
        'Calculate -> you can use Application.Calculation = xlCalculationAutomatic, you should set it to xlManual first if you want to stop it, default - auto
        Application.Calculation = xlCalculationAutomatic
        '+ 2 since you want to paste it at least (1) row beneath the last one
        Last_Filled_Row = ThisWorkbook.Sheets("Output Sheet").Range("C104764").End(xlUp).Row + 2
        'assuming you at least want to start pasting as of row 15
        If Last_Filled_Row < 15 Then
            Last_Filled_Row = 15
        End If

        ThisWorkbook.Sheets("Analysis").Range("B10:N25").Copy
        'use the row as retrieved above
        ThisWorkbook.Sheets("Output Sheet").Range("C" & Last_Filled_Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Next Value

End Sub