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

Question

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

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

Sub Sample()
    Dim lastRow As Long, i As Long
    Dim CopyRange As Range
    Dim rw As Range
    Dim rw1 As Range
    Dim rw2 As Range
    Dim rw3 As Range
    Dim des As Range
    Dim des1 As Range
    Dim des2 As Range
    Dim des3 As Range
    '~~> Change Sheet1 to relevant sheet name
    With Sheets(1)
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To lastRow
            If Len(Trim(.Range("A" & i).Value)) <> 0 Then
                If CopyRange Is Nothing Then
                    Set CopyRange = .Rows(i)
                Else
                    Set CopyRange = Union(CopyRange, .Rows(i))

                    Set rw = Range("P2")
                    Set rw1 = Range("W2")
                    Set rw2 = Range("C2")
                    Set rw3 = Range("R2")
                End If
            End If
        Next

        If Not CopyRange Is Nothing Then
            Set des = Sheets(3).Range("P2")
            Set des1 = Sheets(3).Range("R2")
            Set des2 = Sheets(3).Range("T2")
            Set des3 = Sheets(3).Range("U2")
            '~~> Change Sheet2 to relevant sheet name
            rw.Copy des
            rw1.Copy des1
            rw2.Copy des2
            rw3.Copy des3

            Application.CutCopyMode = False
        End If
    End With
End Sub

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