Question

我目前正在编写一个脚本，该脚本应该从一个工作表中复制四列数据并将其粘贴到同一工作簿中的另一个工作表。注意到我只需要从第二行开始的数据，我尝试过使用column（）和Range（），但它似乎没有工作。

以下是仅在第二行复制一个单元格并粘贴到目标工作表中的另一个单元格的脚本。

Counter

Answer 1

希望这会有所帮助

'// code example copies the Column A on Sheet1 into Column A2 on Sheet2.
Sub CopyFourColumns()
   '// Declare your variables.
    Dim wSheet1 As Worksheet
    Dim wSheet2 As Worksheet
    Dim wSlastRow As Long
    Dim X As Long
    Dim RngToCopy As Range
    Dim RngToPaste As Range

    '// Set here Workbook(Sheets) names
    With ThisWorkbook
        Set wSheet1 = Sheets("Sheet1")
        Set wSheet2 = Sheets("Sheet2")
    End With

    '// Here lets Find the last row of data
    wSlastRow = wSheet1.Range("A" & Rows.Count).End(xlUp).Row
    wSlastRow = wSheet1.Range("B" & Rows.Count).End(xlUp).Row
    wSlastRow = wSheet1.Range("C" & Rows.Count).End(xlUp).Row
    wSlastRow = wSheet1.Range("D" & Rows.Count).End(xlUp).Row

    '// Now Loop through each row
For x = 1 To wSlastRow
    Set RngToPaste = wSheet2.Range("A" & (x + 1))
    With wSheet1
        Set RngToCopy = Union(.Range("A" & x), .Range("A" & x))
        RngToCopy.copy RngToPaste

    Set RngToPaste = wSheet2.Range("B" & (x + 1))
        Set RngToCopy = Union(.Range("B" & x), .Range("B" & x))
        RngToCopy.copy RngToPaste

    Set RngToPaste = wSheet2.Range("C" & (x + 1))
        Set RngToCopy = Union(.Range("C" & x), .Range("C" & x))
        RngToCopy.copy RngToPaste

    Set RngToPaste = wSheet2.Range("D" & (x + 1))
        Set RngToCopy = Union(.Range("D" & x), .Range("D" & x))
        RngToCopy.copy RngToPaste
    End With
Next X
    '// Simple Msg Box
    MsgBox "Copy & Paste is Done."
End Sub

如何从Excel VBA中的不同工作表复制和粘贴整列数据

1 个答案: