title: Importing word tables into excel with formatting
body: <p>I need to import a word document with lots of tables into an excel worksheet. This is easy enough, but the caveat is to keep the formatting of the word doc as it's entered into excel. For instance, some of the fields in word are the color blue, some are red. some are blue with underscore and some are red with underscore. Basically, any color in the word doc needs to match in the excel sheet. This is my code for doing the actual import.</p>
  
  <pre><code>Sub ImportWordTables_1()
      Dim wdDoc As Object
      Dim wdFileName As Variant
      Dim TableNo As Long 'table number in Word
      Dim iRow As Long 'row index in Excel
      Dim iCol As Long 'column index in Excel
      Dim tblCount As Long
      wdFileName = Application.GetOpenFilename("Word files,*.doc;*.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"
          End If
          tblStart = InputBox("Enter table number to start with", "Table Start")
          iCol = 1
          For tblCount = tblStart To .tables.Count
              With .tables(tblCount)
                  'copy cell contents from Word table cells to Excel cells
                  For iRow = 1 To .Rows.Count
                      'find the last empty row in the current worksheet
                      nextRow = ThisWorkbook.ActiveSheet.Range("a" _
                          &amp; Rows.Count).End(xlUp).Row + 1
                      'Just 1 column for now
                      'For iCol = 1 To .Columns.Count
                      ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = WorksheetFunction _
                          .Clean(.cell(iRow, iCol).Range.Text)
                      'ThisWorkbook.ActiveSheet.Cells(nextRow, iCol) = _
                          .cell(iRow, iCol).Range.Text
                      'Next iCol
                  Next iRow
              End With
          Next
      End With
      Set wdDoc = Nothing
  End Sub
  </code></pre>