将纸张1中的粘贴复制到纸张2

Question

我是一个菜鸟，所以任何帮助都表示赞赏。需要帮助编写一个脚本，该脚本将复制列A + B并根据C的值多次粘贴到sheet2。请参阅下面的示例。这将为我们节省大量时间。任何帮助将不胜感激。

Sheet 1中

A       B       C
1111    aaaa     3
2222    bbbb     4
3333    cccc     2

宏观之后

Sheet 2中

A       B       C
1111    aaaa     3
1111    aaaa     3
1111    aaaa     3
2222    bbbb     4
2222    bbbb     4
2222    bbbb     4
2222    bbbb     4
3333    cccc     2
3333    cccc     2

Answer 1

Sub MakeNewTable()

    Dim rCell As Range
    Dim i As Long
    Dim rNext As Range

    'loop through the cells in column A of the source sheet
    For Each rCell In Sheet1.Range("A1:A3")
        'loop as many times as the value in column C of the source sheet
        For i = 1 To rCell.Offset(0, 2).Value
            'find the next empty cell to write to in the dest sheet
            Set rNext = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0)
            'copy A and B from source to the dest sheet
            rCell.Resize(1, 2).Copy rNext.Resize(1, 2)
        Next i
    Next rCell

End Sub

您需要更改工作表参考以符合您的情况。上面使用的工作表引用是Codename引用。如果在VBE（Control + R）中打开Project Explorer，并展开投影，您将看到像'Sheet1（MyTablName）'这样的对象。 Sheet1部分称为Codename，重命名工作表时不会更改。如果要使用选项卡名称，可以使用类似

的内容

ThisWorkbook.Worksheets("MyTabName").Range("A1:A3")

祝你好运。