Convert a column of data to a header for another column

[AlexiaK]

Hello, I have some data in one column and the questions that represent these data in another column. In column A the questions keep repeating, so I do not want to keep everything; but I do want to keep the answers since they represent a different participant each time. Is there a way to convert the data of a column to a header for another column?
Here is an example of what I mean:

This is what I have

What is your gender?	Female
What is your age?	19
What is your preferred type of exercise?	Aerobic
What is your gender?	Male
What is your age?	21
What is your preferred type of exercise	Anaerobic

This is what I would like

What is your gender?	What is your age?	What is your preferred type of exercise?
Female	19	Aerobic
Male	21	Anaerobic

 

[mumps]

How many questions are there? Will it always be 3?

 

[AlexiaK]

How many questions are there? Will it always be 3?

There are 22 questions in total. And I have around 100 participants who all answer the same 22 questions.

 

[mumps]

This macro assumes you have headers in row 1 and your data starts in row 2. The result will be displayed in Sheet2. Change the sheet names (in red) to suit your needs.

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With desWS
        .UsedRange.ClearContents
        .Range("A1").Resize(, 22).Value = WorksheetFunction.Transpose(srcWS.Range("A2:A23"))
    End With
    For x = 2 To LastRow Step 22
        With desWS
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 22).Value = WorksheetFunction.Transpose(srcWS.Range("B" & x).Resize(22))
        End With
    Next x
    Application.ScreenUpdating = True
End Sub

 

[AlexiaK]

This macro assumes you have headers in row 1 and your data starts in row 2. The result will be displayed in Sheet2. Change the sheet names (in red) to suit your needs.

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With desWS
        .UsedRange.ClearContents
        .Range("A1").Resize(, 22).Value = WorksheetFunction.Transpose(srcWS.Range("A2:A23"))
    End With
    For x = 2 To LastRow Step 22
        With desWS
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 22).Value = WorksheetFunction.Transpose(srcWS.Range("B" & x).Resize(22))
        End With
    Next x
    Application.ScreenUpdating = True
End Sub

Thank you!!!

 

[mumps]

You are very welcome.