0

I am trying to Transpose all of column "B", but want to skip a line then grab the next 4 and paste them in the same column. How can I make this loop all of column "B" skipping every 5th line and change the range to the next open cell or "Range" automatically without manually typing each one individually?

Range("B12:B16").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B18:B22").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B24:B28").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

2 Answers 2

1

You could name your cells in the column on Sheet1 as 'data' and then do the following in Sheet2...

     A        B                    C                    D                    E
1    0        =INDEX(data,$A1+1)   =INDEX(data,$A1+2)   =INDEX(data,$A1+3)  =INDEX(data,$A1+4)
2    =A1+5    =INDEX(data,$A2+1)   =INDEX(data,$A2+2)   =INDEX(data,$A2+3)   =INDEX(data,$A2+4)
3    =A2+5    =INDEX(data,$A3+1)   =INDEX(data,$A3+2)   =INDEX(data,$A3+3)   =INDEX(data,$A3+4)
4    ...

and then autofill down as many rows as you need.

0

Try the following, that I've just put together, that is if you're after a macro version rather than the formula based one already suggested.

Essentially, I reckon it should do what your static code does, but within a loop - so there's no manual copy-paste work to do. It might choke if the entire column is full (it will die when it tries to select past the last row).

You might need to change the starting and pasting locations (near the top) to match your specific requirements - it currently copies from column B in to the columns C-F.

Dim CopyCell As Range
Dim PasteCell As Range

'starting location (ie, top of the list to copy)
Range("B1").Select

'pasting location (ie, top-left cell to start pasting to)
Set PasteCell = Range("C1")

Do While ActiveCell.Value <> 0
    'copy the items in the next four rows
    Set CopyCell = ActiveCell.Range("A1")
    ActiveCell.Range("A1:A4").Select
    Selection.Copy

    'move to paste location
    PasteCell.Select

    'paste with transpose
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=True

    'adjust paste location for next paste
    Set PasteCell = PasteCell.Offset(1, 0)

    'return to last copied location and and move down five steps
    'copying 4 rows but moving 5 is how every 5th row is missed
    CopyCell.Select
    ActiveCell.Offset(5, 0).Select
Loop

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .