Трабла с отчетом!Excel и листы.

[Lexxx]

Добрый день!Есть такая проблемка.
В документе Excel на листе 1 есть данные (строки с данными) N
На втором листе печатная форма ,где ручками надо забить в
определенных ячейках дату и фамилию.
Автоматически создается кол-во листов равное кол-ву строк Листа1
начиная с Листа3 до N
Задача:
1 созданные листы перенести печатную форму с Листа2 с забитыми датой и фамилией.
2 в эти листы в определенные ячейки нужно закатать данные с Листа1
1 строка передает данные в ячейки Листа 3 и т.д.Как сделать красиво,
через циклы,а не ковыряться с формулами и ссылками на листы?
Поможите,а то шеф у меня злой.

[Алексей К.]

Код: Выделить всё


'в цикле заносишь данные с первого листа на новые листы (3-N)
'смотри код который я указывал тебе в другом топике
'добавишь типа worksheets(i).cells(x,y)=worksheets(1).cells(5,1) - какие ячейки переносить  и т.д.

for i=3 to n
   'заносишь данные в печатную форму (лист2) с добавленного листа (3-N)
   worksheets(2).cells(x1,y1)=worksheets(i).cells(x,y)
   ' и т.д. скока ячеек надо заносить (можешь цикл добавить если много данных переносить)
   'печатаешь 2 лист c предварительным просмотром
   worksheets(2).printout , , , True
next i


[Lexxx]

Наверное все можно сделать проще.
Не надо плодить листов лишних .На первом листе данные,на
втором сам бланк распоряжения,надо просто считать ячейки первой
строки Листа1 ,заполнить их в определенные ячейки Листа2,вывести на печать,затем их очистить и опять по новой.
Напечатайте код пожалуйста.А то идеи есть,а навыков нет.

[Алексей К.]

Код: Выделить всё


for i=номер_строки_начало to номер_последней_строки 'первого листа
   'заносишь данные в печатную форму (лист2)
   'слева в какие ячеки заносить (x1,y1), справа какие с первого листа (x,y)
   worksheets(2).cells(x1,y1)=worksheets(1).cells(x,y)
   ' и т.д. скока ячеек надо заносить (можешь цикл добавить если много данных переносить)
   'печатаешь 2 лист c предварительным просмотром
   worksheets(2).printout , , , True
next i


Данные заменяются, следвательно и очищать не надо.

[Lexxx]

Sub www()
For i = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Next i
'MsgBox (i - 1)
For x = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
For y = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Worksheets(2).Cells(A1, B3,C6) = Worksheets(1).Cells(Ax, By)
Next y
Next x
Worksheets(2).PrintOut , , , True

End Sub
Не получается помогайте