复制行并粘贴X次，具体取决于单元格值

Question

I have a macro that needs to copy a row and paste it (values, not formula) x times dependent on value in column A (quantity). This needs to be repeated for an 'infinite' amount of rows. Once this is done column A needs to be deleted.

There are similar questions to this but none seem to work for me, my macro also needs to delete two sheets and save the file as a CSV with a given name. I have the save and give name based on cell values just not the copy and paste.

---

So I have only used VBA for about two weeks so i am struggling: I have tried this and that and i can get the odd code to work by itself but never with the rest of the code.

---

Private Sub CommandButton1_Click()

Dim Path As String
Dim Filename1 As String
Dim Filename2 As String
Path = "C:\Users\BergA2\Desktop\CSV Usage Upload\ "

Filename1 = Range("B1")
Filename2 = Range("D1")

I imagine the code would go in here: values for quantity are taken from sheet1 and moved into sheet3 using a simple formula 

Sheets("Sheet2").Delete
Sheets("Sheet1").Delete

ActiveWorkbook.SaveAs Filename:=Path & Filename1 & "-" & Filename2 & ".csv", FileFormat:=xlCSV


End Sub

---

Input ( more then just two columns)

Quantity User   ... 
1        A      ...
3        B      ...
0        C      ...

Output:

User    ...
A       ...
B       ...
B       ...
B       ...

Answer 1

Supposing you have your headers in the first row.

Public Function ReturnCol(ByVal searchString As String) As Integer
Dim rg As Range
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Rows("1:1").Select
Set rg = Selection.Find(What:=searchString, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False)

If rg Is Nothing Then
    ReturnCol = 0
    Exit Function
Else
    ReturnCol = rg.Column
End If

End Function
Sub collect()
Dim col_pos As Integer
Dim usedrows As Long

Dim i As Integer
Dim user As String
Dim quant As Integer

Dim counter As Long
' Assuming headers are in the first row

' Calculate until which point to loop
usedrows = Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row

' Find the positions of the headers (column numbers)
quant_col_pos = ReturnCol("Quantity")
user_col_pos = ReturnCol("User")


counter = 0
If quant_col_pos <> 0 Then
    For i = 2 To usedrows
        user = Cells(i, user_col_pos).Value
        quant = Cells(i, quant_col_pos).Value
        Sheets("Sheet2").Activate

        If i = 2 Then
            Cells(1, 1).Value = "User"
        End If
        ' starting filling values from the 2nd row but somewhere need to remember
        'which one was the last row used therefore counter is used

        For x = 2 + counter To 1 + quant + counter
            ' first column
            Cells(x, 1).Value = user
        Next x
        counter = quant + counter
        Sheets("Sheet1").Activate

    Next i

End If
End Sub

Answer 2

Here you go:

Option Explicit

Sub copyBasedOnColumnA()
    Dim numberCopies As Long
    Dim currentRow As Long
    Dim j As Long

    Dim sht as Worksheet
    Set sht = Sheets("add sheet name")

    currentRow = 2

    Do While Not IsEmpty(sht.Cells(currentRow, 1))
        'determine how often to copy the current row
        numberCopies = sht.Cells(currentRow, 1)

        'copy that many times
        For j = 2 To numberCopies
            sht.Rows(currentRow).copy
            sht.Rows(currentRow).Insert Shift:=xlDown

            'increment the counter, otherwise you also copy all the rows just input
            currentRow = currentRow + 1
        Next j

        'move to next row
        currentRow = currentRow + 1
    Loop

    Application.CutCopyMode = False

    sht.Columns(1).Delete
End Sub

I'm assuming you don't want to copy the header. You can define in which row you want to start by setting the currentRow variable. Also I assumed that you don't have anything import stored in column A.