I have a sheet formatted as follows:
A B C
HEADER ROW
HEADER ROW
101 1-1-10 Address
102 1-3-10 Address
103 2-8-10 Address

I need to create some code to do the following:

Create a new sheet named "Labels"
Copy original sheet A3 to new sheet A1
Merge Cells A1:B6
Copy original sheet B3 to new sheet C1
Copy original sheet C3 to new sheet D1
Add page Break
Do the same as above for the next row on the original sheet and so on. Could
be unlimited number of rows on original sheet.

Any help is greatly appreciated. Thanks

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200910/1

Try this:

==========
Sub MakeLabels()
Dim LR As Long, i As Long, NR As Long
Dim ws As Worksheet
LR = Range("A" & Rows.Count).End(xlUp).Row
NR = 1
Set ws = Sheets("Labels")

For i = 3 To LR
ws.Range("A" & NR) = Cells(i, "A")
ws.Range("C" & NR) = Cells(i, "B")
ws.Range("D" & NR) = Cells(i, "C")
ws.Range("A" & NR, "B" & NR + 5).MergeCells = True
NR = NR + 6
Next i

End Sub
=============

--
"Actually, I *am* a rocket scientist." -- JB
(www.MadRocketScientist.com)

Your feedback is appreciated, click YES if this post helped you.


"brownti via OfficeKB.com" wrote:

I have a sheet formatted as follows:
A B C
HEADER ROW
HEADER ROW
101 1-1-10 Address
102 1-3-10 Address
103 2-8-10 Address

I need to create some code to do the following:

Create a new sheet named "Labels"
Copy original sheet A3 to new sheet A1
Merge Cells A1:B6
Copy original sheet B3 to new sheet C1
Copy original sheet C3 to new sheet D1
Add page Break
Do the same as above for the next row on the original sheet and so on. Could
be unlimited number of rows on original sheet.

Any help is greatly appreciated. Thanks

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200910/1

.

works perfect. Thank you!

JBeaucaire wrote:
Try this:

==========
Sub MakeLabels()
Dim LR As Long, i As Long, NR As Long
Dim ws As Worksheet
LR = Range("A" & Rows.Count).End(xlUp).Row
NR = 1
Set ws = Sheets("Labels")

For i = 3 To LR
ws.Range("A" & NR) = Cells(i, "A")
ws.Range("C" & NR) = Cells(i, "B")
ws.Range("D" & NR) = Cells(i, "C")
ws.Range("A" & NR, "B" & NR + 5).MergeCells = True
NR = NR + 6
Next i

End Sub
=============

I have a sheet formatted as follows:
A B C
[quoted text clipped - 16 lines]

Any help is greatly appreciated. Thanks

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200910/1