I want to copy/past named ranges in the excel sheet to a word document, including the following needs
1- Each table to start on a new page
2- Each table must have a caption; the caption is the contents of the first cell of the table; I don't know how to do this yet
3- The width of the tables can not be fit in portrait orientation and need to be landscape
4- Paper size A4
5- Keep all rows of the table in one page, so I need to make sure there is no extra line spacing
6- the Excel ranges are named as "Table_1", Table_2, ...
I searched, learned, and modified the following code, but it still does not behave as I want in the following.
1- the row height still has spacing, and I have to select the table and adjust the paragraph before and after spacing manually
2- there is a caption already added, which is only the default label with a number, not the one I intended to use
3- all tables do not start on a separate page
I appreciate any help, comment, or suggestion.
Many thanks
1- Each table to start on a new page
2- Each table must have a caption; the caption is the contents of the first cell of the table; I don't know how to do this yet
3- The width of the tables can not be fit in portrait orientation and need to be landscape
4- Paper size A4
5- Keep all rows of the table in one page, so I need to make sure there is no extra line spacing
6- the Excel ranges are named as "Table_1", Table_2, ...
I searched, learned, and modified the following code, but it still does not behave as I want in the following.
1- the row height still has spacing, and I have to select the table and adjust the paragraph before and after spacing manually
2- there is a caption already added, which is only the default label with a number, not the one I intended to use
3- all tables do not start on a separate page
I appreciate any help, comment, or suggestion.
Many thanks
VBA Code:
Sub CopyExcelRangeToWord()
'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
(VBE > Tools > References > Microsoft Word 16.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com
'Hassan K. Abdulrahim modified to copy multi-tables
Dim XlTbl As Excel.Range
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim WrdTbl As Word.Table
Dim TblTitle As String
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Create an Instance of MS Word
On Error Resume Next
'Is MS Word already opened?
Set WrdApp = GetObject(class:="Word.Application")
'Clear the error between errors
Err.Clear
'If MS Word is not already open then open MS Word
If WrdApp Is Nothing Then Set WrdApp = CreateObject(class:="Word.Application")
On Error Resume Next
'Create a New Document
Set WrdDoc = WrdApp.Documents.Add
'Make MS Word Visible and Active
WrdApp.Visible = True
Application.Wait Now + #12:00:01 AM# 'pause for 1 sec
With WrdDoc
.PageSetup.PaperSize = wdPaperA4
.PageSetup.Orientation = wdOrientLandscape
.Sections(1).Range.Paragraphs.LineSpacingRule = wdLineSpaceSingle
End With
For i = 1 To 5
'Copy Range from Excel
Set XlTbl = ActiveSheet.Range("Table_" & i)
'Copy Excel Table Range
XlTbl.Copy
'Paste Table into MS Word
WrdDoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
Application.Wait Now + #12:00:01 AM# 'pause for 1 sec
'Autofit Table so it fits inside Word Document
Set WrdTbl = WrdDoc.Tables(i)
With WrdTbl
.AutoFitBehavior (wdAutoFitWindow)
.Rows.DistributeHeight
.Range.ParagraphFormat.SpaceBefore = 0
.Range.ParagraphFormat.SpaceAfter = 0
.AutoFitBehavior 2 'wdAutoFitWindow
End With
'Insert Table Caption
'TblTitle = "hello caption world"
'WrdTbl.Range.InsertCaption Label:="Table", TitleAutoText:="", Title:=" - " & TblTitle, _
'Position:=wdCaptionPositionAbove, ExcludeLabel:=0
WrdApp.Selection.InsertBreak wdPageBreak
WrdDoc.Range.InsertAfter vbCr
Next i
Set XlTbl = Nothing
Set WrdTbl = Nothing
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub