Скопировать таблицу с заменой одного стобца из массива строк

[Alar]

В книге 1 подготовлена шапка таблицы.
В книге 2 сама шаблонная таблица
В книге 3 в столбце A список из N строк (число строк заранее не известно)

Нужно осуществить цикл копирования таблицы N Раз из книги 2 в Книгу 1 с новыми данными для всего стобца.

Получаеться в итоге таблица с шапкой. в которой различая лишь 1 столбце.

Есть ли готовый макрос или какие функции нужно использовать для организации цикла и копирования все таблицы из книги в книгу?

[EducatedFool]

Есть ли готовый макрос

Готового - нет, но написать - не проблема.

Нужны примеры файлов - что есть изначально, и что должно получиться.
Так будет намного проще разобраться и помочь

Где макросу искать все эти файлы? Они в одной папке?
На момент запуска все файлы будут открыты?

[Alar]

Вероятно я перепутал термины. не книга - а лист.

Сообщение от EducatedFool

Где макросу искать все эти файлы? Они в одной папке?
На момент запуска все файлы будут открыты?

файл один. в нем 3 книги(листа). накидал быстренько пример.

витоге должно получиться в первой книгке вот что:

			шапка
	Стоблец 		
столбец1	столбец2	столбец 3	текст из книги3
1	название1		первое
1	название2		первое
1	название4		первое
1	название5		первое
1	название6		первое
1	название7		первое
1	название8		первое
1	название9		первое
1	название0		первое
1	название55		первое
1	название1		второе
1	название2		второе
1	название4		второе
1	название5		второе
1	название6		второе
1	название7		второе
1	название8		второе
1	название9		второе
1	название0		второе
1	название55		второе
1	название1		третье
1	название2		третье
1	название4		третье
1	название5		третье
1	название6		третье
1	название7		третье
1	название8		третье
1	название9		третье
1	название0		третье
1	название55		третье

Интересен пример макроса. не хотелось бы привелкать Delphi для такой простой задачи

[doober]

Можно так

 Sub Comnbo()
Dim R1 As Long, R2 As Long, R3 As Long, i As Long
R1 = Sheets(2).Range("A" & Cells.Rows.Count).End(xlUp).Row
R2 = Sheets(3).Range("A" & Cells.Rows.Count).End(xlUp).Row
DD1 = Sheets(2).Range("A1:C" & R1)
DD2 = Sheets(3).Range("A1:A" & R2)
i = 9
With Sheets(1)
For m = 1 To R2
For n = 1 To R1
i = i + 1
.Cells(i, 1) = DD1(n, 1)
.Cells(i, 2) = DD1(n, 2)
.Cells(i, 3) = DD1(n, 3)
.Cells(i, 4) = DD2(m, 1)
Next: Next
End With
End Sub

[Alar]

doober, работает так как надо. спасибо. смысл понятен. попытаюсь приспособить для более объёмной таблицы.

[R Dmitry]

Sub test()
a = Sheets(2).[a1].CurrentRegion.Value
b = Sheets(3).[a1].CurrentRegion.Value
ReDim c(1 To UBound(a) * UBound(b), 1 To 4)
For j = 1 To UBound(b)
For i = 1 To UBound(a)
x = x + 1
c(x, 1) = a(i, 1)
c(x, 2) = a(i, 2)
c(x, 3) = a(i, 3)
c(x, 4) = b(j, 1)

Next: Next
Sheets(1).[a10].Resize(UBound(a) * j, 4) = c
End Sub