title: How to preserve source formatting while copying data from word table to excel sheet using VB macro?
body: <p>I am trying to copy some data from a word table to an excel sheet using a VB Macro.</p>
  
  <p>It is copying the text perfectly as desired.</p>
  
  <p>Now i want to preserve the source formatting present in word doc.</p>
  
  <p>The things I want to preserve are</p>
  
  <ol>
  <li>Strike Through</li>
  <li>Color</li>
  <li>Bullets</li>
  <li>New Line Character</li>
  </ol>
  
  <p>I am using the following code to copy -</p>
  
  <p><code>objTemplateSheetExcelSheet.Cells(1, 2) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)</code></p>
  
  <h2>Kindly let me know how I can edit this so as to preserve source formatting.</h2>
  
  <p>The logic I am using is as follows -</p>
  
  <pre><code>wdFileName = Application.GetOpenFilename("Word files (*.*),*.*", , _
  "Browse for file containing table to be imported") '(Browsing for a file)
  
  If wdFileName = False Then Exit Sub '(user cancelled import file browser)
  
  Set wdDoc = GetObject(wdFileName) '(open Word file)
  
  With wdDoc
      'enter code here`
      TableNo = wdDoc.tables.Count '(Counting no of tables in the document)
      If TableNo = 0 Then
          MsgBox "This document contains no tables", _
          vbExclamation, "Import Word Table"
      End If
  End With
  </code></pre>
  
  <p>I am running a table count on the word file. Then for all the tables present in the word doc accessing each row and column of the tables using the above mentioned code.</p>
  
  <p>Ok I am attaching the remaining piece of code as well</p>
  
  <pre><code>'Creating TemplateSheet object
  Set objTemplateSheetExcelApp = CreateObject("Excel.Application")
  'Opening the template to be used
  objTemplateSheetExcelApp.Workbooks.Open ("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")
  Set objTemplateSheetExcelWkBk = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5)
  Set objTemplateSheetExcelSheet = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5) '(Selecting the desired tab)
  
  tblcount = 1
  For tblcount = 1 To TableNo
      With .tables(tblcount)
      '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
              strEach = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
              For arrycnt = 0 To 15
                  YNdoc = InStr(strEach, myArray(arrycnt))
                      If (YNdoc &gt; 0) Then
                          objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt)) = _
                          WorksheetFunction.Clean(.cell(iRow, iCol + 1).Range.Text)
                              If arrycnt = 3 Or arrycnt = 6 Then
                                  objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt) + 1) = _
                                  WorksheetFunction.Clean(.cell(iRow + 1, iCol + 1).Range.Text)
                              End If
                      End If
              Next arrycnt
          Next iCol
      Next iRow
      End With
      Next tblcount
  End With
  intRow = 1
  
  'To save the file
  strFileName = "Newfile.xlsx"
  objTemplateSheetExcelWkBk.SaveAs strFld &amp; "\" &amp; strFileName
  
  objTemplateSheetExcelApp.Quit
  
  Set objTemplateSheetExcelApp = Nothing
  Set objTemplateSheetExcelWkBk = Nothing
  Set objTemplateSheetExcelSheet = Nothing
  
  Set wdDoc = Nothing
  </code></pre>