Sub RotateTable()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, x As Long, y As Long, bRotate As Boolean
Dim RngSrc As Range, RngTgt As Range, TblSrc As Table, TblTgt As Table
With Selection
  If .Information(wdWithInTable) = True Then
  If .Rows.Count > 63 Then
    MsgBox "Too many rows - Word only supports up to 63 columns", vbCritical
    Exit Sub
  End If
  Select Case UCase(Left(InputBox("Do you want to rotate the table:" & vbCr & "R = Right (clockwise); or" & vbCr & "L = Left (counter-clockwise)?"), 1))
    Case "L": bRotate = True
    Case "R": bRotate = False
    Case Else: Exit Sub
  End Select
    Set TblSrc = .Tables(1)
  Else
    MsgBox vbTab & vbTab & "No Table selected!" & vbCr & _
      "Please select some table content before running this macro.", _
       vbCritical, "Selection Error"
    Exit Sub
  End If
End With
With TblSrc
  x = .Rows.Count: y = .Columns.Count
  With .Range
    .Characters.Last.Next.InsertBefore vbCr
    .End = .End + 1
  End With
End With
Set TblTgt = ActiveDocument.Tables.Add(Range:=TblSrc.Range.Characters.Last.Next, NumRows:=y, NumColumns:=x)
With TblTgt
  .Borders = TblSrc.Borders
  If bRotate = True Then
    For i = 1 To x
      For j = 1 To y
        Set RngSrc = TblSrc.Cell(i, j).Range: RngSrc.End = RngSrc.End - 1
        Set RngTgt = .Cell(j, x - i + 1).Range: RngTgt.End = RngTgt.End - 1
        RngTgt.FormattedText = RngSrc.FormattedText
        With .Cell(j, x - i + 1)
          .BottomPadding = TblSrc.Cell(i, j).RightPadding
          .TopPadding = TblSrc.Cell(i, j).LeftPadding
          .RightPadding = TblSrc.Cell(i, j).TopPadding
          .LeftPadding = TblSrc.Cell(i, j).BottomPadding
        End With
      Next
    Next
    On Error Resume Next
    For i = 1 To x
      .Columns(i).Width = TblSrc.Rows(x - i + 1).Height
      If Err.Number = 5149 Then
        .Columns(i).AutoFit
        Err.Clear
      End If
    Next
    For i = 1 To y
      .Rows(i).Height = TblSrc.Columns(i).Width
      If Err.Number = 5149 Then
        .Rows(i).HeightRule = wdRowHeightAuto
        Err.Clear
      End If
    Next
    On Error GoTo 0
    .Range.Orientation = wdTextOrientationDownward
  ElseIf bRotate = False Then
    For i = 1 To x
      For j = 1 To y
        Set RngSrc = TblSrc.Cell(i, y - j + 1).Range: RngSrc.End = RngSrc.End - 1
        Set RngTgt = .Cell(j, i).Range: RngTgt.End = RngTgt.End - 1
        RngTgt.FormattedText = RngSrc.FormattedText
        With .Cell(j, i)
          .BottomPadding = TblSrc.Cell(i, j).LeftPadding
          .TopPadding = TblSrc.Cell(i, j).RightPadding
          .RightPadding = TblSrc.Cell(i, j).BottomPadding
          .LeftPadding = TblSrc.Cell(i, j).TopPadding
        End With
      Next
    Next
    On Error Resume Next
    For i = 1 To x
      .Columns(i).Width = TblSrc.Rows(i).Height
      If Err.Number = 5149 Then
        .Columns(i).AutoFit
        Err.Clear
      End If
    Next
    For i = 1 To y
      .Rows(i).Height = TblSrc.Columns(y - i + 1).Width
      If Err.Number = 5149 Then
        .Rows(i).HeightRule = wdRowHeightAuto
        Err.Clear
      End If
    Next
    On Error GoTo 0
    .Range.Orientation = wdTextOrientationUpward
  End If
End With
TblSrc.Delete
Set RngSrc = Nothing: Set RngTgt = Nothing: Set TblSrc = Nothing: Set TblTgt = Nothing
Application.ScreenUpdating = True
End Sub