简体   繁体   中英

Excel paste multiple times VBA

I am hoping to find a macro which will allow me to paste a certain value X number of times into a separate worksheet. Ideally, the number of "items" can easily be updated.

For example sheet 1 looks like this:

Paste Value     Number of Pastes
Item 1          3
Item 2          1
Item 3          5

On sheet 2, it would appear as

Item 1
Item 1
Item 1
Item 2
Item 3
Item 3
Item 3
Item 3
Item 3

I have found solutions to post on the same worksheet, but haven't been able to get it to paste to a separate worksheet.

Thanks for your time.

Here as a mock you can use to build what you need. In the below code:
PasteValue ( x ) = Col A
Number of times to paste ( y ) = Col B
Paste range = Col F

You will need to change the paste range to your desired sheet. Something like Thisworkbook.Sheets("Sheet2").Range("A" & LRow2").PasteSpecial xlPasteValues should work

Sub pasteX()

Dim LRow As Long, LRow2 As Long, x As Integer, y As Integer
LRow = Range("A" & Rows.Count).End(xlUp).Row

For x = 2 To LRow
y = Range("A" & x).Offset(, 1).Value
    For y = 1 To y
        LRow2 = Range("F" & Rows.Count).End(xlUp).Offset(1).Row
        Range("A" & x).Copy
        Range("F" & LRow2).PasteSpecial xlPasteValues
    Next y
Next x

End Sub

Looping over the rows of the source sheet until blank string appears as Paste Value . For each row, loop Number of Pastes in the target sheet and increment the counter.

Option Explicit

Sub paste()
    Dim rw, rw_target, rw_source As Integer
    Dim sht_source, sht_target As Worksheet

    Set sht_source = Sheets("table1")
    Set sht_target = Sheets("table2")

    rw_source = 2  'first row is header
    rw_target = 1  'start pasting at row 1 in target sheet

    While sht_source.Cells(rw_source, 1).Value <> ""
        For rw = 1 To sht_source.Cells(rw_source, 2).Value
            sht_target.Cells(rw_target, 1).Value = sht_source.Cells(rw_source, 1).Value
            rw_target = rw_target + 1
        Next rw
        rw_source = rw_source + 1
    Wend

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM