Labels

  • Thread starter Thread starter dario90
  • Start date Start date
D

dario90

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
 
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
Click to expand...

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

<[email protected]> skrev i meddelelsen
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
Click to expand...

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

<[email protected]> skrev i meddelelsen


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?
Click to expand...

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
 
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
Click to expand...

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?
Click to expand...

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
 
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
Click to expand...

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


<[email protected]> skrev i meddelelsen
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
Click to expand...

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.
 
Back
Top