Copy paste the columns used range

Viewed 109

I have wrote a code which is working fine but it copies the whole column rather than used range.

Can someone please help me in this regard. I have tried it using lastrow but do not know how to do this and please also share that if i want to add more column then how it would be done.

or is there better way to do this please share.

Your help means a lot to me.

lastrow = totalWS.Cells(totalWS.Rows.Count, 1).End(xlUp).Row

    Sheet1.Columns(1).Copy
Sheet3.Columns(1).PasteSpecial xlPasteValues
Sheet1.Columns(2).Copy
Sheet3.Columns(2).PasteSpecial xlPasteValues
Sheet1.Columns(4).Copy
Sheet3.Columns(4).PasteSpecial xlPasteValues
Sheet1.Columns(5).Copy
Sheet3.Columns(5).PasteSpecial xlPasteValues
Sheet1.Columns(6).Copy
Sheet3.Columns(6).PasteSpecial xlPasteValues
Sheet1.Columns(7).Copy
Sheet3.Columns(7).PasteSpecial xlPasteValues
End Sub
2 Answers
Sub test()
    Dim vDB
    Dim Ws As Worksheet, toWs As Worksheet
    Dim arr As Variant
    Dim i As Integer
    
    Set Ws = Sheets(1)
    Set toWs = Sheets(3)
    
    arr = Array(1, 2, 4, 5, 6, 7)
    For i = 0 To UBound(arr)
        With Ws
            vDB = .Range(.Cells(1, arr(i)), .Cells(Rows.Count, arr(i)).End(xlUp))
        End With
        toWs.Cells(1, arr(i)).Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next i

End Sub

Actually since every copy action takes its time, it gets faster the less single copy actions you have. So copy adjacent rows together would make it faster:

Sheet1.Range(Sheet1.Columns(1), Sheet1.Columns(2)).Copy  'copy column 1 to 2
Sheet3.Range(Sheet3.Columns(1), Sheet3.Columns(2)).PasteSpecial xlPasteValues

Sheet1.Range(Sheet1.Columns(4), Sheet1.Columns(7)).Copy  'copy column 4 to 7
Sheet3.Range(Sheet3.Columns(4), Sheet3.Columns(7)).PasteSpecial xlPasteValues

Now instead of 6 copy actions you only have 2 copy actions, even if the same amount of data is copied this should be measurable faster than copying column by column (even if you copy in a loop, this should be faster).

Related