Multiple printing of cell data onto new worksheet

[biganthony via OfficeKB.com]

Hi,

I have a spreadsheet with a list of 500 names. Their surname is in A1 and
firstname in B1. In column D, I have a number down the column for each person
that represents the number of tickets each person receives in a prize draw.
Some people have 1 ticket, others two, others three or four and so on.

So the data looks like this:

A B C D E
Smith Bill 2
Jones Karen 5
Travis Jo 0
Smith Jess 1

If a person has a 2 (representing two tickets) in cell D1 (as above) then I
would like their first and last name to be printed twice - once in cell A1
and again in cell A2 of the next worksheet called "draw". If the next person
has five tickets I would like their name printed five times: in A3, A4, A5,
A6 and A7 underneath. If the third person has no tickets, then their name
would not appear on the second worksheet ("draw"). This process would
continue through the 500 names in the first worksheet. Not all people would
have a ticket so their name would not appear in the "draw" worksheet. And a
person who has a 10 in the D column would have their name listed ten times in
the "draw" worksheet.

Is what I want possible and can I add code to a button on the first worksheet
to automatically do this?

Many thanks
Anthony

 

[Incidental]

Hi Anthony

The code below would be one way of doing what you want (i think
anyway), what i have done is created the range on the first sheet and
started to work through each cell of the range using the offset method
to pass the number of tickets bought to the variable n i then use this
variable to control the amount of times i want the loop to run that
will add the name to the next empty cell in column a of the sheet
named "Draw". i hope this is clear enough for you but if you have any
problems reply and i will comment the code to explain better what it
is doing.

Option Explicit
Dim i, n As Integer
Dim MyRng, MyCell As Range
Dim NameCell As Range
Private Sub CommandButton1_Click()

Sheets(1).Activate

Set MyRng = [A1:A50]

For Each MyCell In MyRng

If MyCell.Offset(0, 2).Value > 0 Then

n = MyCell.Offset(0, 2).Value

Sheets("Draw").Activate

For i = 1 To n

If [A1].Value > "" Then

Set NameCell = [A65535].End(xlUp).Offset(1, 0)

Else

Set NameCell = [A1]

End If

NameCell.Value = MyCell.Value

NameCell.Offset(0, 1).Value = MyCell.Offset(0, 1).Value

Next i

End If

Next MyCell

End Sub

hope this helps

Steve

 

[biganthony via OfficeKB.com]

Hi Steve

Thank-you. The code completes the task.

Anthony