I have sth like this from sb very helpful but need to copy also values
from column D as a item description and set number of labels copies
even to value in column E for each record ( sheet1 is a base, sheet2
is pattern of label):


Sub CommandButton1_Click()
lr=cells(rows.count,"c").end(xlup).row
for each c in range("C1:C" & lr)
If C.Value <"" Then
c.Copy Sheets("Sheet2").range("E3")
sheets("sheet2").PrintOut
End If
Next C
End sub

Can anybody help me with this?

Try this:

Sub CommandButton1_Click()
lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each C In Range("C1:C" & lr)
If C.Value < "" Then
C.Resize(1, 2).Copy Sheets("Sheet2").Range("E3")
Sheets("sheet2").PrintOut
End If
Next C
End Sub

Regards,
Per

skrev i meddelelsen
...
I have sth like this from sb very helpful but need to copy also values
from column D as a item description and set number of labels copies
even to value in column E for each record ( sheet1 is a base, sheet2
is pattern of label):


Sub CommandButton1_Click()
lr=cells(rows.count,"c").end(xlup).row
for each c in range("C1:C" & lr)
If C.Value <"" Then
c.Copy Sheets("Sheet2").range("E3")
sheets("sheet2").PrintOut
End If
Next C
End sub

Can anybody help me with this?

On 13 Sie, 10:28, "Per Jessen" wrote:
Try this:

Sub CommandButton1_Click()
lr = Cells(Rows.Count, "c").End(xlUp).Row
*For Each C In Range("C1:C" & lr)
* * If C.Value < "" Then
* * * C.Resize(1, 2).Copy Sheets("Sheet2").Range("E3")
* * * Sheets("sheet2").PrintOut
* * End If
*Next C
End Sub

Regards,
Per

skrev i ...

I have sth like this from sb very helpful but need to copy also values
from column D as a item description and set number of labels copies
even to value in column E for each record ( sheet1 is a base, sheet2
is pattern of label):

Sub CommandButton1_Click()
lr=cells(rows.count,"c").end(xlup).row
for each c in range("C1:C" & lr)
* *If C.Value <"" Then
* * *c.Copy Sheets("Sheet2").range("E3")
* * *sheets("sheet2").PrintOut
* *End If
Next C
End sub

Can anybody help me with this?

ok, it works. Thank's. But what with number of copies- how can i
specify it in connection with value in each record so it will be equal
to amount of item pallets?

Sorry, I didn't read your first post carefully enough:-)

C.Resize(1,3).Copy .....

Regards,
Per

skrev i meddelelsen
...
On 13 Sie, 10:28, "Per Jessen" wrote:
Try this:

Sub CommandButton1_Click()
lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each C In Range("C1:C" & lr)
If C.Value < "" Then
C.Resize(1, 2).Copy Sheets("Sheet2").Range("E3")
Sheets("sheet2").PrintOut
End If
Next C
End Sub

Regards,
Per

skrev i
...

I have sth like this from sb very helpful but need to copy also values
from column D as a item description and set number of labels copies
even to value in column E for each record ( sheet1 is a base, sheet2
is pattern of label):

Sub CommandButton1_Click()
lr=cells(rows.count,"c").end(xlup).row
for each c in range("C1:C" & lr)
If C.Value <"" Then
c.Copy Sheets("Sheet2").range("E3")
sheets("sheet2").PrintOut
End If
Next C
End sub

Can anybody help me with this?

ok, it works. Thank's. But what with number of copies- how can i
specify it in connection with value in each record so it will be equal
to amount of item pallets?

On 17 Sie, 15:20, "Per Jessen" wrote:
Sorry, I didn't read your first post carefully enough:-)

C.Resize(1,3).Copy .....

Regards,
Per

skrev i ...
On 13 Sie, 10:28, "Per Jessen" wrote:



Try this:

Sub CommandButton1_Click()
lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each C In Range("C1:C" & lr)
If C.Value < "" Then
C.Resize(1, 2).Copy Sheets("Sheet2").Range("E3")
Sheets("sheet2").PrintOut
End If
Next C
End Sub

Regards,
Per

skrev i
...

I have sth like this from sb very helpful but need to copy also values
from column D as a item description and set number of labels copies
even to value in column E for each record ( sheet1 is a base, sheet2
is pattern of label):

Sub CommandButton1_Click()
lr=cells(rows.count,"c").end(xlup).row
for each c in range("C1:C" & lr)
If C.Value <"" Then
c.Copy Sheets("Sheet2").range("E3")
sheets("sheet2").PrintOut
End If
Next C
End sub

Can anybody help me with this?

ok, it works. Thank's. But what with number of copies- how can i
specify it in connection with value in each record so it will be equal
to amount of item pallets?

ok, thank's. One more question- how to print 4 labels on 1 sheet in a
horizontal position?

Hi

This should do it, just change the "off" value to place the text in the
desired rows:

Sub CommandButton1_Click()

lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each c In Range("C1:C" & lr)
If c.Value < "" Then
Sheets("Sheet2").Columns("E:F").ClearContents
For l = 1 To c.Offset(0, 2).Value
c.Resize(1, 2).Copy Sheets("Sheet2").Range("E3").Offset(l + off,
0)
off = off + 3
Next
Sheets("sheet2").PrintOut
off = 0
End If
Next c
End Sub

Regards,
Per

skrev i meddelelsen
...
On 17 Sie, 15:20, "Per Jessen" wrote:
Sorry, I didn't read your first post carefully enough:-)

C.Resize(1,3).Copy .....

Regards,
Per

skrev i
...
On 13 Sie, 10:28, "Per Jessen" wrote:



Try this:

Sub CommandButton1_Click()
lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each C In Range("C1:C" & lr)
If C.Value < "" Then
C.Resize(1, 2).Copy Sheets("Sheet2").Range("E3")
Sheets("sheet2").PrintOut
End If
Next C
End Sub

Regards,
Per

skrev i
...

I have sth like this from sb very helpful but need to copy also values
from column D as a item description and set number of labels copies
even to value in column E for each record ( sheet1 is a base, sheet2
is pattern of label):

Sub CommandButton1_Click()
lr=cells(rows.count,"c").end(xlup).row
for each c in range("C1:C" & lr)
If C.Value <"" Then
c.Copy Sheets("Sheet2").range("E3")
sheets("sheet2").PrintOut
End If
Next C
End sub

Can anybody help me with this?

ok, it works. Thank's. But what with number of copies- how can i
specify it in connection with value in each record so it will be equal
to amount of item pallets?

ok, thank's. One more question- how to print 4 labels on 1 sheet in a
horizontal position?

On 18 Sie, 10:07, "Per Jessen" wrote:
Hi

This should do it, just change the "off" value to place the text in the
desired rows:

Sub CommandButton1_Click()

lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each c In Range("C1:C" & lr)
* * If c.Value < "" Then
* * * * Sheets("Sheet2").Columns("E:F").ClearContents
* * * * For l = 1 To c.Offset(0, 2).Value
* * * * * * c.Resize(1, 2).Copy Sheets("Sheet2").Range("E3").Offset(l + off,
0)
* * * * * * off = off + 3
* * * * Next
* * Sheets("sheet2").PrintOut
* * off = 0
* * End If
Next c
End Sub

Regards,
Per

skrev i ...

On 17 Sie, 15:20, "Per Jessen" wrote:
Sorry, I didn't read your first post carefully enough:-)

C.Resize(1,3).Copy .....

Regards,
Per

skrev i
...
On 13 Sie, 10:28, "Per Jessen" wrote:

Try this:

Sub CommandButton1_Click()
lr = Cells(Rows.Count, "c").End(xlUp).Row
For Each C In Range("C1:C" & lr)
If C.Value < "" Then
C.Resize(1, 2).Copy Sheets("Sheet2").Range("E3")
Sheets("sheet2").PrintOut
End If
Next C
End Sub

Regards,
Per

skrev i
...

I have sth like this from sb very helpful but need to copy also values
from column D as a item description and set number of labels copies
even to value in column E for each record ( sheet1 is a base, sheet2
is pattern of label):

Sub CommandButton1_Click()
lr=cells(rows.count,"c").end(xlup).row
for each c in range("C1:C" & lr)
If C.Value <"" Then
c.Copy Sheets("Sheet2").range("E3")
sheets("sheet2").PrintOut
End If
Next C
End sub

Can anybody help me with this?

ok, it works. Thank's. But what with number of copies- how can i
specify it in connection with value in each record so it will be equal
to amount of item pallets?

ok, thank's. One more question- how to print 4 labels on 1 sheet in a
horizontal position?

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, 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

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.

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.