Question

我希望找到一个宏，该宏将允许我将某个X值粘贴几次到单独的工作表中。理想情况下，“项目”的数量可以轻松更新。

例如工作表1如下所示：

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

在工作表2上，其显示为

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

我找到了可以在同一工作表上发布的解决方案，但是还无法将其粘贴到单独的工作表上。

感谢您的宝贵时间。

Answer 1

作为模拟，您可以使用它来构建所需的内容。在下面的代码中：
PasteValue（x）= Col A
粘贴次数（y）= B列
粘贴范围= Col F

您需要将粘贴范围更改为所需的纸张。 Thisworkbook.Sheets("Sheet2").Range("A" & LRow2").PasteSpecial xlPasteValues之类的东西应该可以工作

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

Answer 2

遍历源工作表的行，直到空白字符串显示为Paste Value。对于每一行，在目标工作表中循环Number of Pastes并增加计数器。

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

Excel多次粘贴VBA

2 个答案: