Copying rows in an Excel spreadsheet to a new spreadsheet the amount of times of the value in the L column
I have an Excel spreadsheet with information for a raffle.
Each row has the info of one person who bought tickets.
The problem is that I need to make a new spreadsheet (ultimately, 开发者_开发技巧I need to mail merge it into labels) with one row for each ticket, but if one person bought 2 tickets, their info is only in one row in the original spreadsheet, with the amount of tickets in the "L" column.
So I need a macro that will look at he value in the L column, and copy that row to a new spreadsheet L times - if they bought 1 ticket, and the value in the L column is 1, it will copy it 1 time, if they bought 3 tickets, and the value in the L column is 3, it will copy it 3 times.
Can someone tell me how I would go about doing this?
If there's a way to do this during a mail merge, that should work 2, I just figured that it's easier to first make a new spreadsheet, and then just make the labels from that new sheet.
Thanks!!
I ended up finding some code on a site here, and modifying it for my needs. This is what I'm using:
Sub MakeTickets()
Dim X As Long, Z As Long, Qty As Long, Rw As Long
Dim StartRow As Long, LastRow As Long
Dim Source As String, Destination As String
'Define the variables below
StartRow = 2 'the row to start from in the source sheet
FirstDestination = 1 'the row to start from in the destination sheet
FirstCell = "A" 'the first column in each row that you want to copy
LastCell = "O" 'the last column in each row that you want to copy
Source = "Sold" 'source sheet name
Destination = "Tickets" ' destination sheet name
QtyClmn = "L" 'column to get the quantity from
'Until here
Rw = FirstDestination
With Worksheets(Source)
LastRow = .Cells(.Rows.Count, FirstCell).End(xlUp).Row
For X = StartRow To LastRow
Qty = Cells(X, QtyClmn).Value
For Z = 1 To Qty
Rw = Rw + 1
Worksheets(Destination).Range(FirstCell & Rw & ":" & LastCell & Rw).Value = .Range(FirstCell & X & ":" & LastCell & X).Value
Next
Next
End With
End Sub
精彩评论