Copy multiple tables from excel to word

[nsdcoelho]

Hello, I have a workbook with several worksheets and in each of them there is a table I'd like to copy to word (each worksheet consists only on the table) with a VB macro. I've already been able to copy one table but now I want to add the other tables with a "for each... next" command. I'm having trouble in defining a paragraph between tables in word - without the space, each new table will be copied within the former and so on (am I being clear?). Can someone help me? Thank you. The part of the code where I am having issues: For Each cntpy In cntpies

With WordApp.Selection
.Collapse Direction:=0
.InsertBreak Type:=7
End With

'Copy Range from Excel
Worksheets("T." & cntpy).Activate
Worksheets("T." & cntpy).Range("A1:J1").Select
Worksheets("T." & cntpy).Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Paste Table into Word
myDoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False

'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)

Next

 

[nsdcoelho]

I simplified my code to be able to post it here, maybe it gets easier to read: Sub test()

Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim count As Integer
Dim wrdRange As Word.Range
'Create an Instance of MS Word
On Error Resume Next

'Is MS Word already opened?
Set WordApp = GetObject(class:="Word.Application")

'Clear the error between errors
Err.Clear

'If MS Word is not already open then open MS Word
If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

'Handle if the Word Application is not found
If Err.Number = 429 Then
MsgBox "Microsoft Word could not be found, aborting."
End If

On Error GoTo 0

'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate

For count = 1 To 2

'Copy Range from Excel (sheets have the name T.1; T.2 and so forth)
Worksheets("T." & count).Activate
Worksheets("T." & count).Range("A1:J1").Select
Worksheets("T." & count).Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Paste Table into MS Word
myDoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False

'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)
-------------------------problem shoud be here: how can I add a paragraph after this table before copying the next?------------------
Next

End Sub

 

[nsdcoelho]

No one can help me?

 

[Fanel]

[FONT=&quot]Hi![/FONT]
[FONT=&quot]I am new to VBA, and I need help to make the following macro to import from XL ("Sheet2 ") multiple tables 1,2,3..., import them to a specific Wd doc Bookmarks 1, 2, 3, each table from sheet2 linked to one Bookmark from Wd doc.[/FONT]
[FONT=&quot]Based on the macro attached I managed to bring only the first table from Sheet2 and copy to designated spot Bookmark2. Now I need to bring the next table (e.g. III.1 table below) an copy-it to Wd Bookmark3, and so on. [/FONT]
[FONT=&quot]One way, maybe set macro to search the specific text above table (e.g. Chapter III.1), and import only the table below that text.[/FONT]
[FONT=&quot]NOTE: In Wd doc "Template...." I have infomation that I dont want to be erased when the tables are imported from Exl. Thank you!

[/FONT][/COLOR]Sub ExportExcelDataToWordDocument2()



    'Dim wdExcelApp As Application               'Excel is the default library (optional)
    Dim wdWordApp As Word.Application   'Word app
  
  Application.ScreenUpdating = False
  
' Creating a new instance of Word
    Set wdWordApp = New Word.Application 'instantiate a new instance of Word 2010
  
  
    With wdWordApp
      
        ' Making Word Visible on the screen
        .Visible = True             'iff false, document is invisible.
        .Activate ' make it the top pane, bring it to the front.
        


      
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' create a new Word Document based on the specified template
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        .Documents.Add "C:\Users\stefan.georgescu\Desktop\Fisa.dotm"
      
        'as before, copy the whole table from sheet to clipboard.
        Sheet2.Activate
        Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy
      
        .Selection.GoTo what:=-1, Name:="bookmark2" ' -1 means "wdgotobookmark"
        .Selection.Paste      'paste from the clipboard to the Word Doc.
        
  
      
      
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Save WORD Document
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim TheFileName As String
        TheFileName = "C:\Users\stefan.georgescu\Desktop\Fisa.docx"
          
        '(SaveAs is for Office 2003 and earlier - deprecated)
        .ActiveDocument.SaveAs2 TheFileName
            'replaces existing .doc iff exists
          
          
        ' Close Documents and Quit Word
        .ActiveDocument.Close 'close .DOCx
        .Quit 'exit Word
    End With
  
  Application.ScreenUpdating = True
  
    'MEMORY CLEANUP
    Set wdWordApp = Nothing 'garbage collection
    'Set wdExcelApp = Nothing 'OPTIONAL
  
  
End Sub




[COLOR=#2A2E2E][FONT=&quot]

[/FONT]

 

[Fanel]

Sorry, the Word doc name is "Fisa.docx". Thx