Transpose data along with header row.

[Anas_Raza]

I want to transpose data (shifting data from row to colum) but I wants header row along with every colum (while I have transposed data ).

 

[mumps]

This macro assumes that your data is in Sheet1 and the transposed data will be place in Sheet2. Change the sheet names kin the code to suit your needs.

Sub transposeRows()
    Application.ScreenUpdating = False
    Dim x As Long, lastRow As Long, lCol1 As Long, lCol2 As Long
    lastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol1 = Sheets("Sheet1").Cells(1, Sheets("Sheet1").Columns.Count).End(xlToLeft).Column
    For x = 2 To lastRow
        lCol2 = Sheets("Sheet2").Cells(1, Sheets("Sheet1").Columns.Count).End(xlToLeft).Column
        Cells(1, 1).Resize(, lCol1).Copy
        Sheets("Sheet2").Cells(1, lCol2 + 1).PasteSpecial Transpose:=True
        Cells(x, 1).Resize(, lCol1).Copy
        Sheets("Sheet2").Cells(1, lCol2 + 2).PasteSpecial Transpose:=True
    Next x
    Sheets("Sheet2").Columns(1).Delete
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub