Excel VBA copy range (all cells from the left) to embedded Word document

Question

(This question is a follow-up on how to work with a document embedded in an Excel workbook in the Word application interface (instead of in-place). The reason this is necessary is to be able to save the result as an independent document.)

The problem I came up with is that some cells does not fit to criteria cell.Offset(0, -3).Text. So text is not only in one cell with Offset(0, -3) and in Word they should look like:

Legal             John Smith
                  Telephone         +4854132155
                  Email             john.smith@mail.com

In Excel they are in separate rows.

• "Legal" is in B50.
• "John Smith" is in C50.
• "Telephone" is in C51.
• "+4854132155" is in D51.
• "Email" is in C52.
• "john.smith@mail.com" is in C52.

The idea is to have a "Case" called "table" so code will understand that it should copy everything from left of Case "table" row by row (word "table" is located in Column E). Paste to Word as a table and do wdAutoFitWindow so that table would fit perfectly to Word Document Window.

How data looks in Excel:

   A    B                   C                   D                  E
49    Paragraph with number 1                                    main
48    Ok text is text and it is good to have here.. a lot of     normal
50    Legal             John Smith                               table
51                      Telephone         +4854132155            table 
52                      Email             john.smith@mail.com    table
53    Paragraph with number 2                                    main
54    Text again a lot of text again comes here                  normal

What is wrong with current code: Current code runs smoothly. However once it reaches Excel row with word "table" in Column E, it deletes everything already inserted and inserts only last row with parameter "table". So basically it is doing everything right until Case "table". Then as an output you will get:

              Email             john.smith@mail.com

2   Paragraph with number                                   
    Text again a lot of text again comes here     

Instead of:

1   Paragraph with number                                   
    Ok text is text and it is good to have here.. a lot of 
    Legal          John Smith                             
                   Telephone         +4854132155              
                   Email             john.smith@mail.com
2   Paragraph with number                                   
    Text again a lot of text again comes here        

Here is the part I have been tried to implement:

Set xlSht = Sheets("Offer Letter")
  For Each cell In xlRng
    wdRng.InsertAfter vbCr & cell.Offset(0, -3).Text
     Select Case LCase(cell.Value)
        Case "title"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 1")
        Case "main"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 2")
        Case "sub"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 3")
        Case "sub-sub"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 4")
        Case "normal"
          wdRng.Paragraphs.Last.Style = .Styles("Normal")
        Case "contact"
          wdRng.Paragraphs.Last.Style = .Styles("Contact")
          Case "attachment"
          wdRng.Paragraphs.Last.Style = .Styles("Attachment")
          Case "table"

                  xlSht.Range(cell.Offset(0, -3), cell.Offset(0, -1)).Copy
     wdRng.PasteExcelTable False, False, False

      wdRng.Tables(1).AutoFitBehavior wdAutoFitWindow

    End Select
  Next cell

Answer 1

It appears you should be using:

  With wdRng
    .Paragraphs.Last.Range.PasteExcelTable False, False, False
    .Tables(.Tables.Count).AutoFitBehavior wdAutoFitWindow
    .Tables(.Tables.Count).Range.Style = "Normal"
  End With