添加转置到Excel VBA

我目前正在一个更大的项目，我会收回很多word文档，我想转换成excell工作表，然后添加到Access数据库，我已经想通过使用此vba的第一部分：

Sub ImportWordTable() Dim wdDoc As Object Dim wdFileName As Variant Dim TableNo As Integer 'table number in Word Dim iRow As Long 'row index in Excel Dim iCol As Integer 'column index in Excel wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ "Browse for file containing table to be imported") If wdFileName = False Then Exit Sub '(user cancelled import file browser) Set wdDoc = GetObject(wdFileName) 'open Word file With wdDoc TableNo = wdDoc.tables.Count If TableNo = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" ElseIf TableNo > 1 Then TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _ "Enter table number of table to import", "Import Word Table", "1") End If With .tables(TableNo) 'copy cell contents from Word table cells to Excel cells For iRow = 1 To .Rows.Count For iCol = 1 To .Columns.Count Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) Next iCol Next iRow End With End With Set wdDoc = Nothing End Sub 

不过，我需要一种方法转置表，而不保留原始数据，有没有办法，我可以添加任何种类的VBA代码到现有的代码，以结合这两个工作？

Answer 1

replace下面的代码，并检查这是你所需要的

  With .tables(TableNo) 'copy cell contents from Word table cells to Excel cells For iRow = 1 To .Rows.Count For iCol = 1 To .Columns.Count Cells(iCol, iRow) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) Next iCol Next iRow End With