如何复制并在Excel VBA中不同的工作表粘贴整个数据列

问题描述 投票:1回答:1

我目前正在对应该数据的四列从一个工作表中对它们复制并粘贴到另一个工作表在同一工作簿的脚本。注意,我只需要两个行的数据开始,我试图与列()和量程(),但它似乎并不奏效。

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

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
excel vba
1个回答
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
© www.soinside.com 2019 - 2024. All rights reserved.