将Excel电子表格中的行复制到新电子表格中L列中值的数量

Question

我有一个包含抽奖信息的Excel电子表格。

每一行都有一个人购买门票的信息。

问题是我需要制作一张新的电子表格（最终，我需要将它合并到标签中），每张票一行，但是如果一个人购买了2张票，他们的信息只在一行中原始电子表格，“L”列中的票数量。

所以我需要一个宏，它会查看他在L列中的值，并将该行复制到新的电子表格L次 - 如果他们购买了1张票据，并且L列中的值为1，则它将复制它是1次，如果他们购买了3张票，并且L列中的值是3，则将其复制3次。

有人能告诉我怎么去做这件事吗？

如果在邮件合并期间有办法做到这一点，应该可以工作2，我只是想先制作一个新的电子表格，然后再从新的工作表制作标签。

谢谢！

Answer 1

我最终在网站here上找到了一些代码，并根据我的需要修改了它。 这就是我正在使用的：

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