Transpose Data/ Re-Arrange Columns and Rows

Hi Guys/Gals,

I have a data set that I would like to re-arrange. I think looking at the attachment will be more helpful and less confusing than thrying to explain in detail.

The Start tab is the original set of data. And the Desired Layout is what I'm hoping the result will be.

I don't think the Transpose function will be appropriate here because I can not predict how large the data array will be (the actual spreadsheet is MUCH bigger). Also, I don't think that the Transpose function can copy the column labels down 10 rows like I need.

If you don't have a specific answer, please let me know if it is possible to do this.

Thanks in advance!

Use this code -

Option Explicit
Dim lcol As Long
Dim lrow As Long
Dim i As Long
Dim j As Long
Dim a As Long

Sub tranpose_data()

Application.ScreenUpdating = False

Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Output"
With Worksheets("Output")
    .Range("A1").Value = "Keyword"
    .Range("B1").Value = "Page"
    .Range("A1:B1").Font.Bold = True
End With

With Worksheets("Start")
    lcol = .Range("IV1").End(xlToLeft).Column
    For i = 1 To lcol
        lrow = .Cells(.Rows.Count, i).End(xlUp).Row
        For j = 2 To lrow
            a = Worksheets("Output").Range("A" & Rows.Count).End(xlUp).Row
            Worksheets("Output").Range("A" & a + 1).Value = .Cells(1, i).Value
            Worksheets("Output").Range("B" & a + 1).Value = .Cells(j, i).Value
        Next j
    Next i
End With

Application.ScreenUpdating = True

End Sub