CODEWITHSUNDEEP
vbaexcelcsv
JvdP
JvdP

Reputation: 11

VBA Copy alternating columns to adjacent columns

So I want to copy column DC and DE from one file to column N and O from another file. With the code I have now it copies the value from column DC in both column N and O. I checked and the correct columns are selected with Range("DC2:DC" & numRows & "," & "DE2:DE" & numRows).

Set wbCSV = Workbooks.Open(Filename:=Worksheets("Sheet1").TextBox1.Value)

'Copy data
With wbCSV
 numRows = Cells(Rows.Count, "A").End(xlUp).Row
 LTOE = .Sheets(1).Range("DC2:DC" & numRows & "," & "DE2:DE" & numRows).Value
 .Close
End With

'Paste data
Worksheets("Sheet1").Range("N18:O" & numRows + 16).Value = LTOE

Upvotes: 1

Views: 349

Answers (1)

user4039065
user4039065

Reputation:

That Union of discontiguous columns won't work on a direct value transfer or array. Take an extra step to shuffle the data over one column.

dim LTOE  as variant, i as long

Set wbCSV = Workbooks.Open(Filename:=Worksheets("Sheet1").TextBox1.Value)

'Copy data
With wbCSV
    numRows = .Cells(.Rows.Count, "A").End(xlUp).Row
    LTOE = .Sheets(1).Range("DC2:DE" & numRows).Value
    .Close
End With

'tighten the columns up
for i=lbound(LTOE , 1) to ubound(LTOE ,1)
    LTOE(i, 2) = LTOE(i, 3)
next i

'remove the extra column (ok with preserve since we are resizing the last rank)
redim preserve LTOE(lbound(LTOE , 1) to ubound(LTOE ,1), 1 to 2)

'Paste data
Worksheets("Sheet1").Range("N18).resize(ubound(ltoe, 1), ubound(ltoe, 2)) = LTOE

Upvotes: 1

Related Questions