Copy and paste every other cell

[jtodd]

Hi
How would I adapt the folowing code to copy and paste everyother cell.
Sheets("InOutData").Select
Range("I3:I46").Select
Selection.Copy
Sheets("LayoutVolumesFittest").Select
Range("D55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

EG startin at I3 copy every other cell into another sheet values only and tranposing to D55,E55 ect.

 

[Fluff]

How about

Sub chk()
   Dim i As Long, c As Long
   c = 4
   For i = 3 To 46 Step 2
      Range("I" & i).Copy Sheets("LayoutVolumesFittest").Cells(55, c)
      c = c + 1
   Next i
End Sub

 

[Peter_SSs]

A couple of other approaches too.

Sub CopyEverySecondAndTranspose_v1()
  Sheets("LayoutVolumesFittest").Range("D55:Y55").Value = Application.Index(Sheets("InOutData").Range("I3:I46"), Filter(Application.Transpose(Evaluate("if(mod(row(I3:I46),2)=1,Row(I3:I46)-2,""x"")")), "x", False), 1)
End Sub


Sub CopyEverySecondAndTranspose_v2()
  With Sheets("LayoutVolumesFittest").Range("D55:Y55")
    .Formula = "=INDEX(InOutData!$I3:$I46,COLUMNS($D:D)*2-1)"
    .Value = .Value
  End With
End Sub

 

[jtodd]

Sorry cannot get this to work at all
Think it is copying the formula not the value only ,
Also have to be int the sheet I am copying from , this may not be the case so need to refer to this sheet .

 

[Fluff]

Not sure which of us you were talking to, but this will copy values only

Sub chk()
   Dim i As Long, c As Long
   c = 4
   For i = 3 To 46 Step 2
      Sheets("LayoutVolumesFittest").Cells(55, c).Value = Sheets("InOutData").Range("I" & i).Value
      c = c + 1
   Next i
End Sub

 

[Peter_SSs]

Sorry cannot get this to work at all
Think it is copying the formula not the value only ,
Also have to be int the sheet I am copying from , this may not be the case so need to refer to this sheet .

Then I'm thinking you haven't tried my suggestions since ..
- Both suggestions transfer values only, not formulas, and
- It doesn't matter what sheet you are on when the codes are run as all ranges are referenced to the relevant sheet.

 

[jtodd]

Hi Sorry
Reply was for Fluff.

Thanks works fine but I do not think I explained myself very well ,
I also need the it to paste into every other cell in "LayoutVoumesFittest",

 

[jtodd]

HI Peter_SSs

Sorry no not tried your suggestions yet , wil do so this morning .

Many thanks

 

[Peter_SSs]

HI Peter_SSs

Sorry no not tried your suggestions yet , wil do so this morning .

Probably no point testing my previous codes as they were written for your original request which you now appear to have changed. Originally you said

... tranposing to D55,E55 ect.

Now you say

I also need the it to paste into every other cell in "LayoutVoumesFittest",

.. which presumably means to paste into D55, F55 etc

So, if you want cell
I3 to go to D55 in the other sheet,
I5 to go to F55
I7 to go to H55
.
.
I46 to go to AT55
then the version of my suggestion would be:

Sub CopyEverySecondAndTranspose_v3()
  With Sheets("LayoutVolumesFittest").Range("D55:AT55")
    .Formula = "=IF(MOD(COLUMNS($D55:D55),2)=0,"""",INDEX(InOutData!$I3:$I46,COLUMNS($D:D)))"
    .Value = .Value
  End With
End Sub

 

[jtodd]

Peter

Works like a charm , I will be applying to a larger range now I understand.

Thanks for your patience