Формирование квитанции на новом листе

[ddv.code]

Дебрый день, Гуру!
Возникла необходимость создания квитанции на новом листе с прайс-листа. Допустим, я ставлю кол-во заправок картриджей в одной из ячеек и по нажатии на кнопку "сформировать квитанцию" данные должны перенестись на новый лист. В чем-то я разобрался, но не совсем. Данные переносятся, но как сделать, чтобы текст константой дописывался ниже таблицы и автоматически менялся бы номер квитанции? Незнаю как правильно объяснить, ниже пример и образец что должно получатся.
Помогите пожалйста чайнику.

[R Dmitry]

Сообщение от ddv.code

Дебрый день, Гуру!
Возникла необходимость создания квитанции на новом листе с прайс-листа. Допустим, я ставлю кол-во заправок картриджей в одной из ячеек и по нажатии на кнопку "сформировать квитанцию" данные должны перенестись на новый лист. В чем-то я разобрался, но не совсем. Данные переносятся, но как сделать, чтобы текст константой дописывался ниже таблицы и автоматически менялся бы номер квитанции? Незнаю как правильно объяснить, ниже пример и образец что должно получатся.
Помогите пожалйста чайнику.

по мне проще новый написать


Sub main()
On Error Resume Next
Dim arrF, i&, x&
With Worksheets("Прайс")
arr = .Range("A8:D" & .Cells(Rows.Count, 4).End(xlUp).Row).Value
End With
ReDim arrF(1 To 5, 1 To UBound(arr)): x = 1
For i = 1 To UBound(arr)
If arr(i, 4) > 0 Then arrF(1, x) = x: arrF(2, x) = arr(i, 1): arrF(3, x) = _
arr(i, 2): arrF(4, x) = arr(i, 3): arrF(5, x) = arr(i, 4): x = x + 1
Next i
arrF(1, x - 1) = ""
With Worksheets("Квитанция")
.Cells(4, 3) = .Cells(4, 3) + 1
.Range("A7:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Clear
.Range("A7:E" & x + 7) = Application.Transpose(arrF)
.Range("A7:E" & x + 5).Borders.Color = 0
.Range("D" & x + 5 & ":E" & x + 5).Font.Bold = True: .Range("D" & x + 5 & ":E" & x + 5).Font.Size = 10
.Range("A" & x + 10) = "Сдал:_________________________ __"
.Range("C" & x + 10) = "Принял:___________________________ "
.Range("B" & x + 12) = "М.П."
.Range("A" & x + 15 & ":E" & x + 15).MergeCells = True
.Rows(x + 15).RowHeight = 21
.Range("A" & x + 15).Font.Italic = True
.Range("A" & x + 15) = "*Заправка картриджа включает в себя очистку всех деталей картриджа, полировку и промывку барабанов, лез" _
& "вий," & Chr(10) & " прижимных роликов, заполнение тонером . Полировка и промывка осуществляется специальными растворами."
.Range("A" & x + 17 & ":E" & x + 17).MergeCells = True
.Rows(x + 17).RowHeight = 21
.Range("A" & x + 17).Font.Italic = True
.Range("A" & x + 17) = "*Восстановление картриджа включает в себя замену барабанов, лезвий, подающих и прижимных роликов, " & Chr(10) & " устране" _
& "ние прочих дефектов, заполнение тонером."
End With
End Sub

[ddv.code]

Огромное спасибо за помощь! Как можно с Вами связаться? Есть пару небольших вопросиков по теме...

[R Dmitry]

Сообщение от ddv.code

Огромное спасибо за помощь! Как можно с Вами связаться? Есть пару небольших вопросиков по теме...

dg_rusak@mail.ru
либо задавайте вопросы прямо в форуме