从 Excel 复制到 Word。Word 创建大量空白页

问：

我有一些代码应该在excel中复制一系列带有数据的单元格，然后将其粘贴到word文档中。该代码运行良好，但问题是，当它将数据粘贴到 word 中时，表格后面会出现几个空白页。代码在下面。有没有人知道如何修复它，以便只有带有数据的部分被复制，而我可以摆脱空白页？

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