Sub ImportWordTable2() 'Import all tables to separate sheets 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 (*.doc),*.doc", , _ "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 If wdDoc.tables.Count = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" Else For TableNo = 1 To wdDoc.tables.Count With .tables(TableNo) Sheets.Add after:=Sheets(Worksheets.Count) 'copy cell contents from Word table cells to Excel cells For iRow = 1 To .Rows.Count For iCol = 1 To .Columns.Count On Error Resume Next ActiveSheet.Cells(iRow, iCol) =
WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) On Error GoTo 0 Next iCol Next iRow End With Next TableNo End If End With Set wdDoc = Nothing End Sub
No comments:
Post a Comment