Excel VBA Transpose dynamic list with repeating header to new sheet

Question

I need to copy a list of data with a repeating header and transpose it to another sheet. The VBA needs to accommodate different size and quantity of lists.

Sheet 1 looks like this:

Fruit
apple
pear
grape
Fruit
banana
orange
strawberry

Sheet 2 needs to look like this:

apple pear grape
banan orange strawberry

Possible duplicate of [Transpose a range in VBA](http://stackoverflow.com/questions/13174916/transpose-a-range-in-vba) — cyboashu, Dec 10 '16 at 00:10
So you need to do that, cool. What brought you here? Did you try to write a program and got stuck? Got any questions? How can we help? — vacip, Dec 10 '16 at 00:24

score 1 · Accepted Answer · answered Dec 10 '16 at 00:59

Assuming that there are no blank rows and that your list is in Column A and Worksheet1 is active when you run the macro

Sub flip_it()
Dim RowCount As Long
Dim SrcRng As Range
Rows(1).Insert
RowCount = Range("A1048576").End(xlUp).Row
Range("B1:B" & RowCount).FormulaR1C1 = "=if(RC[-1]=""FRUIT"",row(),""x"")"
Range("B1:B" & RowCount).Value = Range("B1:B" & RowCount).Value
Range("B1:B" & RowCount).RemoveDuplicates 1, xlNo
Range("C1").FormulaR1C1 = "=Counta(C2)"

    For x = 2 To Range("C1").Value
        row1 = Range("B" & x).Value + 1
            If x = Range("c1").Value Then
                row2 = RowCount
            Else
                row2 = Range("B" & x + 1).Value - 1
            End If
        Set SrcRng = Range(Cells(row1, 1), Cells(row2, 1))
        SrcRng.Copy

        With Worksheets("Sheet2")
            .Range("A" & x - 1).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone, skipblanks, Transpose:=True
        End With

    Next x

Worksheets("Sheet2").Activate

End Sub

This works great! How can I make one minor modification?: The Fruit heading is in column A but the data to be copied and transposed is in column B. — kidron, Dec 12 '16 at 16:14

Excel VBA Transpose dynamic list with repeating header to new sheet

1 Answers1