How can I traverse a column and copy its values to two more columns?

Question

I have been trying to create a macro that will go through a spreadsheet and copy figures in Cells E, then paste them into Cell K and L, then repeat as the macro transverse column E. i.e. E1 will be copied to K1 and L1, E2 will be copied to K2, L2 etc...

This is what i have done so far:

Sub uy()
'
' Macro1 Macro
' lo
'
   Range("E299").Select
      Do Until IsEmpty(ActiveCell)
         If ActiveCell.Value < 0 Then
            Selection.Copy
            Range("K299").Select
                Do Until IsEmpty(ActiveCell)
                    ActiveSheet.Paste
            Loop
            Range("L299").Select
                Do Until IsEmpty(ActiveCell)
                    ActiveSheet.Paste
            Loop
         Else
            Range("L299").Select
                Do Until IsEmpty(ActiveCell)
                    ActiveSheet.Paste
            Loop
        End If
        ActiveCell.Offset(1, 0).Select
      Loop
End Sub

When i run the macro it just highlights cell E229 with a broken line box and Cells K299, L299 are left blank. I feel Range("K299").Select, Do Until IsEmpty(ActiveCell), ActiveSheet.Paste part is selecting and copying a blank cell, so it will terminate itself as it meets the "Do Until IsEmpty(ActiveCell)" criteria.

Is there a way for me to fix this?

I won't post as an answer because I'm not sure, but try changing `select` to `activate` http://stackoverflow.com/questions/7180008/excel-select-vs-activate — Bmo, Aug 08 '14 at 11:49
can't you do this with worksheet formulas in the target/destination cells? You could try `=IF(E299<0,E299,"")` then copy that down and in columns K and L — Our Man in Bananas, Aug 08 '14 at 11:54

score 0 · Answer 1 · edited Aug 08 '14 at 14:45

0

I think something like this would work.

Sub Copy()

    Dim intRowCount as Long
    Dim intLastRow as Long

    intRowCount = 2
    intLastRow = Application.CountA(Sheets(1).Range("e:e"))

    For intRowCount = 2 To intLastRow
        Sheets(1).Range("K" & intRowCount ).Value = Sheets(1).Range("E" & intRowCount ).Value
        Sheets(1).Range("L" & intRowCount ).Value = Sheets(1).Range("E" & intRowCount ).Value
    Next

End Sub

edited Aug 08 '14 at 14:45

WGS

13,969
4
48
51

answered Aug 08 '14 at 12:35

farzaaaan

410
3
9

Edited your answer and changed `Integer` to `Long`. It's better practice in this case. Also, changed `Set intRowCount = 2` to `intRowcount = 2`. `Set` is not needed there, it's not an object. Also, quality-wise, `Application.CountA(Sheets(1).Range("e:e"))` can pose some severe problems in getting the last row. What if there are blanks? They won't be counted using this, which might give you a lower number than expected. Lastly, try using `Union` for the equivalence part to bring it down to one line. :) – WGS Aug 08 '14 at 14:47

score 0 · Answer 2 · answered Aug 08 '14 at 14:34

I'm not quite sure if i got you right. but if you want to just copy one range to an other then this would do it.

Private Sub CommandButton1_Click()
      For i = 1 To Cells(Rows.Count, 5).End(xlUp).Row
            If Cells(i, 5) <> "" Then
                  Cells(i, 11).Value = Cells(i, 5).Value
                  Cells(i, 12).Value = Cells(i, 5).Value
            End If
      Next i
End Sub

This marco works as long as cell 'i' in column E isn't empty and takes the value of cell 'i' in column E and puts it into column K and L

Kind regards

score 0 · Answer 3 · answered Aug 08 '14 at 14:40

First, don't use Activate or Select. They're 99% useless in most code. Next, don't use copy and paste. It's slow for this kind of approach.

The following code is much more streamlined and faster.

Sub EtoKL()

    Dim WS As Worksheet
    Dim LRow As Long, Iter As Long

    Set WS = ThisWorkbook.Sheets("Sheet1") 'Change as necessary.
    With WS
        LRow = .Range("E" & .Rows.Count).End(xlUp).Row 'Get last used row in Column E.
        For Iter = 1 To LRow 'Iterate from 1 to last used row.
            Union(.Range("K" & Iter), .Range("L" & Iter)).Value = .Range("E" & Iter).Value
        Next
    End With

End Sub

Let us know if this helps.

How can I traverse a column and copy its values to two more columns?

3 Answers3