Петля в Excel 2013

Question

У меня возникли проблемы с получением цикла для запуска.

У меня есть таблица Source1 со списком значений в столбце A на вкладке CC. Каждый номер должен быть скопирован отдельно в ячейку B1 на вкладке «Шаблон» в электронной таблице Source2. Cell B1 запускает консолидацию информации (в основном, индексированную информацию) и отображает ее в шаблоне - совокупную картину большого количества фоновых данных. Затем я копирую A1: K71 и вставляю его на вкладку «Выход» в электронной таблице Source1.

Я хочу работать над списком в столбце A вкладки CC и автоматически добавлять каждый вывод из таблицы Source2 на вкладку «Вывод».

У меня есть копия/вставка, но у меня проблемы с циклом.

Selection.Copy 
Windows("Source2.xlsx").Activate 
Range("B1").Select 
ActiveSheet.Paste 
Range("A1:K71").Select 
Application.CutCopyMode = False 
Selection.Copy 
Windows("Source1.xlsm").Activate 
Sheets("Ouput").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell 

Answer 1

@ Андрей, прочитав и перечитав ваш вопрос, я не думаю, что нужна какая-либо петля. Результаты макрорекордера, которые вы указали выше, предоставляют информацию о том, как вы можете это решить. Я проверил это, создав книгу Source1 со значениями, расположенными в столбце A на листе с надписью CC. Я также добавил лист с надписью «Выход». Затем я открыл вторую книгу с листом с надписью «Шаблон». Вот Подпроцедура я использовал для получения результата, я думаю, что вы описываете выше:

Sub AndrewProject() 
' COMMENT: Declare variables used throughout this procedure 
     Dim InitialVals As Range 
     Dim OutputVals As Range 
     Dim FinalResults As Range 
     Dim FinalOutput As Range 
     Dim cell As Variant 

' COMMENT: Set the range objects so they are easier to manipulate 
     Set InitialVals = Workbooks("Source1").Worksheets("CC's").Range("A2:A72") 
     Set OutputVals = Workbooks("Source2").Worksheets("Template").Range("B2:B72") 
     Set FinalResults = Workbooks("Source2").Worksheets("Template").Range("A2:K72") 
     Set FinalOutput = Workbooks("Source1").Worksheets("Output").Range("A2:K72") 

' COMMENT: This line copies the values in Source1 Workbook and pastes them into Source2 Workbook 
     InitialVals.Copy 
     OutputVals.PasteSpecial xlPasteValues 
' COMMENT: Additional code goes here to create the desired output. To simplify things, I put a 
' function in Source2, column K that concatenates the string "Output" with InitialVals copied 
' from Source1. To emulate your Source2 Template, I placed random values between 1 and 1000 in 
' Cells A2:A72 and C2:J72. 

' COMMENT: Copy the FinalResults from Source2 "Template" tab into the Source1 "Output" tab 
     FinalResults.Copy 
     FinalOutput.PasteSpecial xlPasteAll 
End Sub 

Answer 2

OK ... @ Андрей это должно быть моей последней попыткой. Я считаю, что это отвечает на ваш вопрос.

Sub AutomateIt() 
' Declare your variables 
    Dim cell   As Range 
    Dim Src1CC  As Range 
    Dim Src2Template As Range 
    Dim Src2Calcs As Range 
    Dim Src1Output As Range 
    Dim NextRow  As Long 
    Dim count  As Integer 

' Set the ranges so they can be manipulated 
    Set Src1CC = Workbooks("Source1").Worksheets("CC").Range("A1") 
    Set Src2Template = Workbooks("Source2").Worksheets("Template").Range("B1") 
    Set Src2Calcs = Workbooks("Source2").Worksheets("Template").Range("A1:K72") 
    Set Src1Output = Workbooks("Source1").Worksheets("Output").Range("A1:K72") 
    Src2Template.ClearContents 
    count = 0 

' Loop through all the cells and calculate stuff 
    For Each cell In Src1CC.Range(Src1CC, Src1CC.End(xlDown)) 
     'Determine the next empty row (plus a space for readability) 
     NextRow = Cells(Rows.count, 1).End(xlUp).Row + 2 

     'Send a copy of the Src1CC cell value to the Src2Template 
     cell.Copy Src2Template 

     'Re-calculate A1:K72 based on cell value 
     Src2Calcs.Calculate 

     'Copy Src2Calcs results and paste to Source1 Output 
     Src2Calcs.Copy 
     Src1Output.PasteSpecial xlPasteValues 

     count = count + 1 
     MsgBox "You have pasted " & count & " results." 

     'Change Src1Output Range so that the next paste is the next blank row 
     'plus one additional row for readability. 
     Set Src1Output = Workbooks("Source1").Worksheets("Output").Range(Cells(NextRow, 1), Cells(NextRow, 11)) 
    Next cell 
End Sub