1
\$\begingroup\$

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
    table.DataBodyRange.Copy
    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

Result:

enter image description here

\$\endgroup\$

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.