I have copied some sample code from the Internet.
I want to copy the table on Excel into a new word document.
Here is my code:
Sub ExcelRangeToWord()
'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 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com
Dim tbl As Excel.Range
Dim WordApp As Word.Application 'was highlighted as error .
Dim myDoc As Word.Document
Dim WordTable As Word.Table
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Copy Range from Excel
Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects("Table1").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."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Create a New Document
Set myDoc = WordApp.Documents.Add
'Copy Excel Table Range
tbl.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)
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
It contains at least one error, because it just runs from the beginning:
Dim WordApp As Word.Application 'was highlighted as error .--> haven't defined the variable
You are missing reference.
To fix this:
Click on Tools to select References Scroll down till you find
“Microsoft Word 15.0 Object Library” Make sure you check the box;
Source: Copy worksheet information to Word using VBA in Microsoft Excel
Related
Sub exceltoword()
'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Copy Range from Excel
Set tbl = ThisWorkbook.Worksheets(1).Range("A:E")
'Update colums width
Columns("A").ColumnWidth = 5
Columns("B:E").ColumnWidth = 25
'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."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Create a New Document
Set myDoc = WordApp.Documents.Add
'Copy Excel Table Range
tbl.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)
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
This is my current VBA code, I am trying to copy, paste and excel pivot table in sheet1 to MS.Word. I am struggle in how to remove blank in Excel pivot table and makes the Word format read friendly. Below is my current output screenshot, many thanks.
enter image description here
I wish I could just copy straight from excel but the program that I am copying into doesn't allow that.
This is what I have so far.
Sub exceltoword()
Dim RangeToCopy As Range
Set RangeToCopy = Range("A2")
Dim WordApp As Word.Application
Set WordApp = New Word.Application
WordApp.Visible = True
Dim WordDoc As Word.Document
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
WordDoc.Close
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Application.Wait (Now + TimeValue("0:00:005"))
Set RangeToCopy = Range("B2")
Set WordApp = New Word.Application
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
With a simple google search of how to copy from excel to word is where I found the below, I added comments that tell you where to change variables, you can add multiple tables pasted to any bookmarks you set in word, make sure you set your references.
your code will look something like this after you declare you word application
Option Base 1 'Force arrays to start at 1 instead of 0
Sub ExcelTablesToWord()
'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 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com
Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim TableArray As Variant
Dim BookmarkArray As Variant
'List of Table Names (To Copy)
TableArray = Array("MAKE YOUR TABLE ARRAY IN EXCEL AND PUT THE NAME HERE",)
'List of Word Document Bookmarks (To Paste To - in word goto Insert->Bookmark)
BookmarkArray = Array("BOOKMARK NAME FROM MICROSOFT WORD DOC HERE")
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Set Variable Equal To Destination Word Document
On Error GoTo WordDocNotFound
Set WordApp = GetObject(class:="Word.Application")
WordApp.Visible = True
Set myDoc = WordApp.Documents("FULL FILE PATH TO YOUR WORD DOCUMENT")
On Error GoTo 0
'Loop Through and Copy/Paste Multiple Excel Tables
For x = LBound(TableArray) To UBound(TableArray)
'Copy Table Range from Excel
Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range
tbl.Copy
'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(x)
WordTable.AutoFitBehavior (wdAutoFitWindow)
Next x
'Completion Message
MsgBox "Copy/Pasting Complete!", vbInformation
GoTo EndRoutine
'ERROR HANDLER
WordDocNotFound:
MsgBox "Microsoft Word file 'Excel Table Word Report.docx' is not currently open, aborting.", 16
'Put Stuff Back The Way It Was Found
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
Basically you set your variables to the word application, define the arrays you want to paste in your excel sheet (in your instance B5?) then it will loop through and paste your arrays to the Bookmarks you set in your word document, which you can set to any location in your word document.
I have two ranges in the excel file .
(A79-I84) & (A90-I92)
I am now using the Excel.RANGE.copy. to copy the two tables and paste on the word file .
However , the two ranges become two separate tables and the original excel table format cannot inherit to the new word file .Also , some cells from the word report will be shown in two lines .
In conclusion , the format of the word report will be very messy .
How to integrate the two table into one table with good table format or alignments?
the new table will be generated like this :
(red pen = problems )
My codes:
Sub ExcelRangeToWord()
Dim tbl0 As Excel.RANGE
Dim tbl As Excel.RANGE
Dim tbl2 As Excel.RANGE
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Copy Range from Excel
'Set tbl0 = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A78:I83")
Set tbl = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A78:I83")
Set tbl2 = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A90:I92")
'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."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Create a New Document
Set myDoc = WordApp.Documents.Add
'Trigger copy separately for each table + paste for each table
tbl.Copy ' paste range1
myDoc.Paragraphs(1).RANGE.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=True, _
RTF:=False
'before that...
'...go to end of doc and add new paragraph
myDoc.Bookmarks("\EndOfDoc").RANGE.InsertParagraphAfter
tbl2.Copy 'paste range2
'Paste Table into MS Word last paragraph
myDoc.Paragraphs(myDoc.Paragraphs.Count).RANGE.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=True, _
RTF:=False
'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
new aftereffect
Try the following. Simply hide rows in between (which ever you don't want to see) and copy as one range to be from "A79:I92" and paste as a picture. Credit here (#sneep) for sub to resize image. Note this will resize all images but could be adapted to target just one.
Option Explicit
Sub ExcelRangeToWord()
Dim tbl0 As Excel.Range
Dim Tbl As Excel.Range
Dim tbl2 As Excel.Range
Dim wordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet2") ' Change e.g. sheet9.Name
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
ws.Rows("84:89").EntireRow.Hidden = True 'ADJUST AS APPROPRIATE
'Copy Range from Excel
'Set tbl0 = ws.RANGE("A78:I83")
Set Tbl = ws.Range("A78:I92")
' Set tbl2 = ws.Range("A90:I92")
'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."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
wordApp.Visible = True
wordApp.Activate
'Create a New Document
Set myDoc = wordApp.Documents.Add
'Trigger copy separately for each table + paste for each table
Tbl.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wordApp.Selection.Paste
wordApp.Selection.TypeParagraph
wordApp.Selection.PageSetup.Orientation = wdOrientLandscape
resize_all_images_to_page_width myDoc
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
Sub resize_all_images_to_page_width(myDoc As Document)
'https://blog.qiqitori.com/?p=115
Dim inline_shape As InlineShape
Dim percent As Double
For Each inline_shape In myDoc.InlineShapes
inline_shape.LockAspectRatio = msoFalse
inline_shape.ScaleWidth = 100
inline_shape.ScaleHeight = 100
percent = myDoc.PageSetup.TextColumns.Width / inline_shape.Width
inline_shape.ScaleWidth = percent * 100
inline_shape.ScaleHeight = percent * 100
Next
End Sub
I am just referencing some sample code ,that want to move An Excel table Into A new word document.
However , it contains at least one error .
Set tbl = ThisWorkbook.Worksheets(Sheet9.Name).ListObjects("Table1").Range
Error: Need object here.
Link :
https://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba
Full codes:
Sub ExcelRangeToWord()
'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 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com
Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
'Copy Range from Excel
Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects("Table1").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."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Create a New Document
Set myDoc = WordApp.Documents.Add
'Copy Excel Table Range
tbl.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)
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
Based on the information you supplied in comments, it appears you don't actually have a table in your worksheet (which is why ListObjects("Table1") wasn't returning an object) and you actually just want to transfer a Range.
If so, replace the line setting tbl with something like:
Set tbl = ThisWorkbook.Worksheets("whatever_sheet_name_you_are_using").Range("A1:E10")
I have some code that is supposed to copy a range of cells with data in excel and then paste it into a word document. The code works well, but the problem is that when it paste the data into word several blank pages appear after the table. the code is underneath here. Does anybody have an idea of how to fix it so that only the part with data gets copied and I can get rid of the blank pages?
Sub ExportToWord()
'Option Explicit
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim SrcePath As String
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
'Copies the specified range in excel
Set sht = Worksheets("Calculations")
Set StartCell = Range("M3")
'Refresh UsedRange
Worksheets("Calculations").UsedRange
'Find Last Row
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Select Range
sht.Range("M3:R" & LastRow).Copy
'Create an Instance of MS Word
On Error Resume Next
'Is MS Word already opened?
If WordApp Is Nothing Then Set WordApp = CreateObject(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."
GoTo EndRoutine
End If
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Create a New Document
Set myDoc = WordApp.Documents.Add
'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)
'Insert Header logo
SrcePath = ""
myDoc.Sections.Item(1).Headers(wdHeaderFooterPrimary) _
.Range.InlineShapes.AddPicture (SrcePath)
'Prompts users to save document
WordApp.Documents.Save NoPrompt:=False
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
'Closes the Word application and the document
On Error GoTo Err1:
myDoc.Close
WordApp.Quit
Set WordApp = Nothing
Err1:
End Sub
There is a manual way to do it.
Select your table, click the right button of your mouse, and go to 'format cells'.
Then select 'Number'-'Number'-'ok' like the picture I attached.
example
I hope it is helpful.