If i understand your requirements right, then you want to paste data in two
columns and as many rows as needed. When all data are pasted, print the
output sheet. Otherwise please explain in words what you desire.

The variables RowOff and ColOff is to be changed to make output look as
desired.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

' //Clear Output sheet
Sheets("Arkusz2").Cells.ClearContents

'// Change variables below to place output
'// as desired on the output sheet
RowOff = 2
ColOff = 4

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(rOff, cOff) _
.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

If cOff = 0 Then
cOff = ColOff
Else
cOff = 0
rOff = rOff + RowOff
End If
Next
off = 0
End If
Next c

Sheets("Arkusz2").PrintOut
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Regards,
Per


skrev i meddelelsen
...
On 18 Sie, 13:04, "Per Jessen" wrote:
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

As a effect of that code i have sth like this:

ITEM: 2128128
675858
658568
67567
and i wanted to do this:


ITEM 34434 ITEM 69769

ITEM 65678 ITEM 858658

To sum up, i want to print each item on a different label.