Копирование строк в электронной таблице Excel в новую электронную таблицу сколько раз значение в столбце L

Question

У меня есть таблица Excel с информацией для розыгрыша.

В каждой строке есть информация об одном человеке, который купил билеты.

Проблема в том, что мне нужно создать новую таблицу (в конечном счете, мне нужно отправить письмо по почте (с метками) с одной строкой для каждого билета, но если один человек купил 2 билета, их информация находится только в одной строке в исходной электронной таблице с количеством билетов в столбце «L».

Итак, мне нужен макрос, который будет смотреть на значение в столбце L и копировать эту строку в новую электронную таблицу L раз - если они купили 1 билет, а значение в столбце L равно 1,копирует его 1 раз, если они купили 3 билета, а значение в столбце L равно 3, он скопирует его 3 раза.

Может кто-нибудь сказать мне, как я поступил бы с этим?

Если есть способ сделать это во время слияния, это должно сработать 2, я просто подумал, что проще сначала создать новую электронную таблицу, а затем просто сделать метки из этого нового листа.

Спасибо !!

Answer 1

В итоге я нашел какой-то код на сайте здесь и изменил его для своих нужд. Вот что я использую:

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