Excel convert columns to new rows

Question

I have a table that looks like this:

  |   A   |     B      |     C      |     D      |
  +-------+------------+------------+------------+
1 | Name  | Langua         


        

Answer 1

The following formula should work. The data in sheet2 would always reflect the data on sheet1 so you wouldn't have to re-run a macro to create a new list.

That being said, using a macro to generate it is probably a better choice as it would allow more flexability should you need to add a 4th language or something at a later date.

In Sheet2!A2

=INDIRECT("Sheet1!A"&ABS(INT((ROW()+1)/3))+1)

In Sheet2!B2

=INDIRECT("Sheet1!"&IF(ABS(INT((ROW()+1)/3)-(ROW()+1)/3)=0,"B",IF(ABS(INT((ROW()+1)/3)-(ROW()+1)/3)=(1/3),"C","D"))&ABS(INT((ROW()+1)/3))+1)

Add the column titles in A1 and B1 then autofill the formula down the sheet.

Answer 2

This will do the trick. It is also dynamic supports as many language columns as you want with as many languages per person. Assumes the data is formatted as per the example:

Sub ShrinkTable()
    Dim maxRows As Double
    Dim maxCols As Integer
    Dim data As Variant
    maxRows = Cells(1, 1).End(xlDown).row
    maxCols = Cells(1, 1).End(xlToRight).Column

    data = Range(Cells(1, 1), Cells(maxRows, maxCols))

    Dim newSht As Worksheet
    Set newSht = Sheets.Add

    With newSht

        .Cells(1, 1).Value = "Name"
        .Cells(1, 2).Value = "Column"

        Dim writeRow As Double
        writeRow = 2

        Dim row As Double
        row = 2
        Dim col As Integer

        Do While True

            col = 2
            Do While True
                If data(row, col) = "" Then Exit Do 'Skip Blanks

                'Name
                .Cells(writeRow, 1).Value = data(row, 1)

                'Language
                .Cells(writeRow, 2).Value = data(row, col)

                writeRow = writeRow + 1
                If col = maxCols Then Exit Do 'Exit clause
                col = col + 1
            Loop

            If row = maxRows Then Exit Do 'exit cluase
            row = row + 1
        Loop

    End With
End Sub

Answer 3

Messy but should work:

For Each namething In Range("A1", Range("A1").End(xlDown))
    Range("A1").End(xlDown).Offset(1, 0) = namething.Value
    Range("A1").End(xlDown).Offset(0, 1) = namething.Offset(0, 2)
    Range("A1").End(xlDown).Offset(1, 0) = namething.Value
    Range("A1").End(xlDown).Offset(0, 1) = namething.Offset(0, 3)
    namething.Offset(0, 2) = ""
    namething.Offset(0, 3) = ""
Next

Then just sort