简体   繁体   中英

Excel VBA Select every other cell and paste it into another sheet?

I need to copy data from the 8th row into another sheet(sheet 2). I only need to copy every other cell, it should copy cell C8(first cell where the value is), E8, G8, I8 and so on from all the upto cell IK8.

Is there any way to do this? I have tried the step function in the for loop but its not working and only selecting one cell.It only pastes one value for cells H2:H130.


Sub Workplace()

Dim rng As Range
Dim LastRow As Long
Dim I As Long

LastRow = Worksheets("Questions").Range("C" & Rows.Count).End(xlUp).Row
For I = 8 To LastRow Step 3
Set rng = Worksheets("Questions").Range("C" & I)
rng.Copy
Next I
Worksheets("Sheet1").Range("H2:H130").PasteSpecial Transpose:=True
End Sub

You need to increment the column, not the row.

And move the paste inside the loop, though you need to increment the destination cell.

For i = 3 to 245 Step 2 ' column C to column IK
    Set rng = Worksheets("Questions").Cells(8, i)

    With Worksheets("Sheet1")
        Dim dest as Range
        Set dest = .Range("H" & .Rows.Count).End(xlUp).Offset(1)
    End With

    rng.copy Destination:=dest
Next

Or better, just use Union to build up a range to copy and then copy in one step:

For i = 3 to 245 Step 2 ' column C to column IK
    If rng Is Nothing Then
        Set rng = Worksheets("Questions").Cells(8, i)
    Else
        Set rng = Union(rng, Worksheets("Questions").Cells(8, i))
    End If
Next

rng.Copy
Worksheets("Sheet1").Range("H2").PasteSpecial Transpose:=True

Application.CutCopyMode = False

EDIT :

"Is there a way to paste it in the first empty cell for Row H in sheet 1 instead of giving it a range?"

Yes, like the following:

Worksheets("Sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Transpose:=True

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM