Hi, actually i have a changed formula because in your version it
copied formulas from cells- not the values. Now it's sth like that:

Private Sub CommandButton1_Click()


Application.ScreenUpdating = False

lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each c In Range("E1:E" & lr)
If c.Value < "" Then
c.Resize(1, 2).Copy
Sheets("Arkusz2").Range("E3") _
.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

For x = 1 To c.Offset(0, 2).Value
Sheets("Arkusz2").PrintOut
Next x

End If

Next c

Application.ScreenUpdating = True
End Sub



I think that your last proposition should be added in 'For x......'
loop. Am I right?

Hi, not quite. I think it should be like this:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

off = 0
lr = Cells(Rows.Count, "E").End(xlUp).Row
For Each c In Range("E1:E" & lr)
If c.Value < "" Then
c.Resize(1, 2).Copy
For x = 1 To c.Offset(0, 2).Value
Sheets("Arkusz2").Range("E3").Offset(off, 0) _
.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
off = off + 3
Next
Sheets("Arkusz2").PrintOut
off = 0
Application.CutCopyMode = False
End If
Next c

Application.ScreenUpdating = True
End Sub

Regards,
Per