VBA Code to copy a fixed number of cells from a row in one sheet to paste to a diagonal in pairs to another sheet.

Marvalisa

New Member
Joined
Sep 20, 2014
Messages
9
To start I first locate the row in the first sheet through MsgBox.

.Range(.cells(r, 2), .Cells(r, 2))

Next, I want to copy that row starting at column 5 through 18,

then I want to paste to another sheet in pairs along a diagonal.
For example, col 5 and 6 would paste to row 5 column b and c; col 7 and 8 would post to row 6 column d and e.

I can do this in a very naive way that is not efficient. I could copy col 5 and 6 then paste and repeated the process until done.
I was trying to set up a loop but I could not get it to work correctly. Any help would be greatly appreciated.

Here is a clip of my naive VBA code.
.Range(.Cells(r, 5), .Cells(r, 6)).Copy wsSR.Range("B5:C5")
.Range(.Cells(r, 7), .Cells(r, 8)).Copy wsSR.Range("D6:E6")
.Range(.Cells(r, 9), .Cells(r, 10)).Copy wsSR.Range("F7:G7")
.Range(.Cells(r, 11), .Cells(r, 12)).Copy wsSR.Range("H8:I8")
.Range(.Cells(r, 13), .Cells(r, 14)).Copy wsSR.Range("J9:K9")
.Range(.Cells(r, 15), .Cells(r, 16)).Copy wsSR.Range("L10:M10")
.Range(.Cells(r, 17), .Cells(r, 18)).Copy wsSR.Range("N11:O11")

There must be a way to grab the information once from one worksheet,
then paste into another without going back and forth each time which is slow as molasses.
 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,400
Office Version
  1. 365
Platform
  1. Windows
Is it really only the values you are trying to copy or are you wanting to copy formulas, formatting data validation etc?
If only values, then try this sort of idea.

VBA Code:
Sub CopyToDiagonal()
  Dim data As Variant
  Dim i As Long
  
  data = Sheets("Sheet1").Range("E2:R2").Value
  For i = 1 To UBound(data, 2) Step 2
    Sheets("Sheet2").Cells(5 + (i - 1) / 2, 1 + i).Resize(, 2).Value = Application.Index(data, 1, Array(i, i + 1))
  Next i
End Sub

Marvalisa 2020-03-21 1.xlsm
DEFGHIJKLMNOPQRS
1
21234567891011121314
3
Sheet1


Marvalisa 2020-03-21 1.xlsm
BCDEFGHIJKLMNO
4
512
634
756
878
9910
101112
111314
12
Sheet2
 

Marvalisa

New Member
Joined
Sep 20, 2014
Messages
9
Wow! It worked perfectly in the example you gave but my implementation didn't go quite as well. There is a lot packed into the few lines of code you gave. I thought I would just give a quick try and see if I couldn't get it to work then unpack what everything means after.
Here is what I inserted into my code:
data = .Range(.Cells(r, 5), .Cells(r, 18)).Value
For i = a To UBound(data, 2) Step 2
wsSR.Cells(5 + (i - 1) / 2, 1 + i).Resize(, 2).Value = Application.Index(data, 1, Array(i + 1))
Next i
 

Marvalisa

New Member
Joined
Sep 20, 2014
Messages
9
Wow! It worked perfectly in the example you gave but my implementation didn't go quite as well. There is a lot packed into the few lines of code you gave. I thought I would just give a quick try and see if I couldn't get it to work then unpack what everything means after.
Here is what I inserted into my code:
data = .Range(.Cells(r, 5), .Cells(r, 18)).Value
For i = a To UBound(data, 2) Step 2
wsSR.Cells(5 + (i - 1) / 2, 1 + i).Resize(, 2).Value = Application.Index(data, 1, Array(i + 1))
Next i
It seems rows and columns are off by 1 when I run the my program. I am not sure because I don't understand the code just yet. This is the data from the first sheet.
2020-03-21_11-50-24.jpg

Here is the result I got:

2020-03-21_11-39-49.jpg
 

Marvalisa

New Member
Joined
Sep 20, 2014
Messages
9
Thanks, Peter I found my mistakes and everything works as it should. I appreciate your help. I will try and understand what you done.
Marvalisa
 

Watch MrExcel Video

Forum statistics

Threads
1,127,765
Messages
5,626,742
Members
416,201
Latest member
brianhf

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top