Sub test()
    Dim x      As Long
    Dim y      As Long
    Dim cl    As Long
    Dim rw    As Long
    Dim cnt    As Long
    cl = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    rw = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    For x = 1 To cl
        cnt = 1
        For y = 2 To rw
            If Cells(y, x) <> "" Then Cells(rw + cnt, cl - x + 1) = Cells(y, x) + 1
            cnt = cnt + 1
        Next y
    Next x
End Sub