如何將行從一個Excel工作表復制到另一個工作表，並使用VBA創建重復項？

Question

我有兩張紙的excel工作簿：sheet1在A到R列中有一個大數據表，在第1行有標題。Sheet2在A到AO列中有數據。

我使用VBA嘗試從sheet1復制行並將其粘貼到sheet2的末尾。 另外，我只需要復制A到R列，而不是整個行。

換句話說，需要將工作表1中的單元格A2：R2復制到第一行和第二行，而第一行和第二行在A列中沒有數據。

任何幫助深表感謝！

@AlistairWeir，我有以下代碼可以從sheet1復制所需的單元格，但是我不知道如何將每一行復制兩次。

Sub example()

For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

If Not IsEmpty(ce) Then

Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 18).Value = Range(ce, ce.Offset(0, 17)).Value

End If

Next ce

End Sub

Answer 1

嘗試這個：

Option Explicit
Sub CopyRows()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Integer, k As Integer
    Dim ws1LR As Long, ws2LR As Long

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")

    ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
    ws2LR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1

    i = 2
    k = ws2LR
    Do Until i = ws1LR
        With ws1
            .Range(.Cells(i, 1), .Cells(i, 18)).Copy
        End With

        With ws2
            .Cells(k, 1).PasteSpecial
            .Cells(k, 1).Offset(1, 0).PasteSpecial
        End With

        k = k + 2
        i = i + 1
    Loop
End Sub

如果在工作簿中它們被稱為不同的事物，請更改Sheet1和Sheet2 。