Shift data from row to row

[EMoe]

I have this code that transfers info from one worksheet to another via
macro button. It goes to the next column with each click of the button.


This code goes from column to column.
How do I change this to transfer info from row to row lets say starting
at row 4, then 5 etc... Or is their an easier way to do this? All I want
to do is take data from cells B1:B10 from sheet (1) over to sheet (2)
A4:J4. The next time the button is click shift down to A5:J5, etc...

Sub TransferData()
Dim v1 As Variant, v2 As Variant
Dim sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range
v1 = Array("B1:B2", "D3134", "D3639")
v2 = Array(3, 6, 10)
Set sh1 = Sheets("WorksheetCopy")
Set sh2 = Sheets("Worksheet Info")

Set rng = sh2.Cells(3, "IV").End(xlToLeft)(1, 2)
If rng.Column < 3 Then ' change to 4 if you want Column D as the start
Set rng = sh2.Range("C3")
End If
For i = LBound(v1) To UBound(v1)
sh1.Range(v1(i)).Copy
sh2.Cells(v2(i), rng.Column).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
Skipblanks:=False, Transpose:=False
Next
sh2.Activate
Range("D23").Select
Application.ScreenUpdating = True
End Sub

Thanks,
EMoe

 

[Vacation's Over]

first take a look at TRANSPOSE in help

in your paste special you set it to false
(you copied macro recorder for the paste values)

by setting it to True you can get out of all the array reading cell by cell
and just copyB1:b10 directly to first cell of new range and it will paste
all values into a row

 

[EMoe]

You are right! I changed "transpose" to true, and it pasted the value
in a row. But clicking the button again pasted the values again on th
same row.

I need for the new values to paste on the next row, and not straigh
across.

How do I do this?

EMo

 

[Vacation's Over]

using End(XLDown) should move to the end of used range and place you in the
first empty row

sh2.Cells(v2(i), rng.Column).End(XLDown).PasteSpecial _

Also with these two changes you should have half as many lines of code and
no array