View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Shift columns each click of the button

Your code puts the results in column D rather than Column C, nonetheless,
this is written to begin in column C and progress to the right. It assumes
that the 3rd row will contain a value after that column has been pasted to.

Sub TransferData()
Dim v1 As Variant, v2 As Variant
Dim sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range
v1 = Array("B1:B2", "D31:D34", "D36:D39")
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

--
Regards,
Tom Ogilvy



"EMoe" wrote in message
...

Hello Programmers,

This code takes data from selected cells on sheet 1, then tranfers them
to a column starting with C on sheet2. How do I add to this code, so
that the next time I hit the macro button, the data shifts over to
column D, then E, etc...


'subroutine to transfer data to another sheet

Sub TransferData()
Application.ScreenUpdating = False
Sheets("WorksheetCopy").Range("B1:B2").Copy
Sheets("Worksheet Info").Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("WorksheetCopy").Range("D31:D34").Copy
Sheets("Worksheet Info").Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("WorksheetCopy").Range("D36:D39").Copy
Sheets("Worksheet Info").Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range("D23").Select
Application.ScreenUpdating = True
End Sub
Thanks,
EMoe


--
EMoe
------------------------------------------------------------------------
EMoe's Profile:

http://www.excelforum.com/member.php...o&userid=23183
View this thread: http://www.excelforum.com/showthread...hreadid=374920