just tried a little VBA code to transpose existing ListObject Table and creating new ListObject Table with name SrcTable_TRANS

Any thoughts or mischiefs in my code?

Calling sub:

Public Sub main()
    TransposeListObject "T_TREAT_TEST", Cells(16, 11)
End Sub

Transpose Sub:

Public Sub TransposeListObject(srcTable As String, TargetCell As Range)

    Dim i As Long
    Dim ws As Worksheet
    Dim table As ListObject
    Dim table2 As ListObject

    ' Disable ScreenUpdating for faster
    Application.ScreenUpdating = False

    Set ws = ActiveWorkbook.ActiveSheet
    Set table = ws.ListObjects(srcTable)

    ' Clear (DEBUG purposes)
    Range(Cells(15, 9), Cells(25, 22)).Clear

    ' Copy source Table and paste it Transposed to TargetCell
    TargetCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    ' Add first column (header in the past)
    For i = 1 To table.ListColumns.count
        TargetCell.Offset(-1 + i, -1).Value = table.ListColumns(i).Range.Value
    Next i

    ' Creata Table (ListObject)
    Set table2 = ws.ListObjects.Add(xlSrcRange, _
        Range(TargetCell.Offset(0, -1), _
              TargetCell.Offset(table.ListColumns.count - 1, table.ListRows.count - 1)), _
        xlNo, xlGuess, TargetCell)

    ' Rename table TBL_NAME --> TBL_NAME_TRANS
    table2.Name = table.Name & "_TRANS"

    ' Clear selection
    TargetCell.Offset(0, -1).Select
    Application.CutCopyMode = False

    ' Reapply ScreenUpdating for normal behaviour
    Application.ScreenUpdating = True

End Sub


enter image description here


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.