Remove Blank Pages in Word from Excel

[b_choplick]

I am trying to write a macro that moves all visible sheets in a workbook to a new word document with a page break between sheets, and then removes all blank pages in the word document. So far, my macro does all of that fine, but I do not know how to make it delete all of the blank pages. Any way to modify this code to fit the purpose?

Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet

Application.ScreenUpdating = False
Application.StatusBar = "Creating new document..."
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add


wdApp.ActiveDocument.PageSetup.TopMargin = wdApp.InchesToPoints(0.5)
wdApp.ActiveDocument.PageSetup.BottomMargin = wdApp.InchesToPoints(0.1)

For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = True Then

Application.StatusBar = "Copying data from " & ws.Name & "..."

ws.UsedRange.Copy ' or edit to the range you want to copy
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste

Application.CutCopyMode = False
wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter
' insert page break after all worksheets except the last one
If Not ws.Name = Worksheets(Worksheets.Count).Name Then
With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
End If

Next ws
Set ws = Nothing
Application.StatusBar = "Cleaning up..."
' apply normal view

With wdApp.ActiveWindow
If .View.SplitSpecial = wdPaneNone Then
.ActivePane.View.Type = wdPrintView
Else
.View.Type = wdNormalView
End If
End With
Set wdDoc = Nothing
wdApp.Visible = True
Set wdApp = Nothing
Application.StatusBar = False