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