How to copy and paste whole columns of data from different worksheets in Excel VBA

Question

I'm currently working on a script that is supposed to copy four columns of data from one worksheet and paste over them to another worksheet in the same workbook. Noted I only need the data from row two onwards, I have tried with column() and Range() but it doesn't seem to be working.

Below are the script which only copies one cell on second row and paste over to another cell in the target worksheet.

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

0m3r 0m3r · Accepted Answer · 2015-05-24T05:56:08

hope this helps

'// 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

How to copy and paste whole columns of data from different worksheets in Excel VBA

1 Answers