I suggest that you post your question to Microsoft.Public.Excel.Programming

Hello Access101,

I was also looking at a way to do this fairly easily in Excel, but am also
pretty inexperienced in Excel VBA (and rather less experienced than Doug in
Word VBA). In fact I would prefer to avoid VBA altogether if possible, and
tried to solve this using Jet SQL, which, given a chance and a bit of
additional infrastructure, lets you generate the required table using a
single SQL statement.

But anyway, the thing I was stuck on was the use of "CurrentRegion" to
select the necessary block of data, which your code helped me with. But I
think yours can be simplified quite a lot, unless there are problems copying
source cells to data cells, or other oddities in the Excel object model that
I'm not aware of.

Here's my current code with some comments that may help you. But I think
Doug's suggestion to follow this up in an Excel group is sound - they will
know much more about the Excel object model, constant and variable naming
conventions, and so on. They may also be able to advise on the best way to
avoid overwriting existing data, creating new sheets and workbooks, dealing
with errors (e.g. exceeding the maximum number of rows in a workbook, which
I haven't tried to deal with here).

Thanks for posting your solution,

Peter Jamieson

-------------------------------------------------------------------------
Sub RepeatMailingLabels()

' Using constants makes it easier to modify the sheets you want to use
' But there are other ways to parameterise this, for example using workbook
and worksheet names

Const sourceSheet = 1 ' the sheet number containing the source data
Const targetSheet = 2 ' the sheet number that will contain the label data
Const countColumn = 1 ' the column in sourceSheet that contains the label
count

' Let's try to declare every variable we use

Dim c As Integer
Dim r As Long
Dim lDestStartRow As Long
Dim lDestRow As Long

' Let's put "Excel." in front of Excel objects. That way, we have a much
better
' chance of using this code even in Word VBA

Dim wsSource As Excel.Worksheet
Dim wsTarget As Excel.Worksheet
Dim mbrAnswer As VbMsgBoxResult
Dim rng2Copy As Excel.Range
Set wsSource = Excel.ActiveWorkbook.Sheets(sourceSheet)
Set wsTarget = Excel.ActiveWorkbook.Sheets(targetSheet)

If ActiveWorkbook.Sheets.Count < 2 Then

' Spell it out! The clearer the better.

 MsgBox "Your Workbook must have at least two Sheets. The first sheet is
assumed to be the source of the data, and column one contains the label
count. The second sheet will be overwritten by the results.", vbCritical,
"Sheet Count"
 Exit Sub
Else
 mbrAnswer = MsgBox("This macro will delete all information on the second
sheet in your workbook: '" & UCase(wsTarget.Name) & "'" & vbCr & vbCr & "Do
you want to proceed?", vbQuestion + vbYesNo, "Run Label Maker")
 If mbrAnswer = vbYes Then

' Clear everything in the target worksheet
    wsTarget.Cells.Clear
 Else
   Exit Sub
 End If
End If

' Copy the first row

Set rng2Copy = wsSource.Cells(1, 1).CurrentRegion
For c = 1 To rng2Copy.Columns.Count
 wsTarget.Cells(1, c) = wsSource.Cells(1, c)
Next c

' set up the starting row in the target

lDestStartRow = 2

' for each row in the source...

For r = 2 To rng2Copy.Rows.Count

...make the number of copies in the target specified in the appropriate
column
 For lDestRow = lDestStartRow To lDestStartRow + wsSource.Cells(r,
countColumn) - 1
   For c = 1 To rng2Copy.Columns.Count
     wsTarget.Cells(lDestRow, c) = wsSource.Cells(r, c)
   Next
 Next

' remember where to start the next set of copies in the target
 lDestStartRow = lDestStartRow + wsSource.Cells(r, countColumn)
Next

' It's good programming practice to release objects that we
' set up

Set wsTarget = Nothing
Set wsSource = Nothing
End Sub

-------------------------------------------------------------------------