Copy all textboxes (contained in each worksheet) to a word document

Question

I am trying to export each worksheet content (textboxes and shapes, no cellcontent) into a word document. The result is not what I expected. If there are 2 worksheets each one with a text box, 1 text box will be copied twice and the other one won't be copied at all!

Private Sub Export()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True

For Each ws In ActiveWorkbook.Worksheets
    ws.Shapes.SelectAll
    Selection.Copy

WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False

Next ws

End Sub

What I am missing:

1. Insert a page break after each ws is exported
2. Understanding why a textbox from a worksheet is copied twice and another textbox from a different worksheet is not copied at all

Answer 1

1. Adding page breaks

If you want to insert a page break at the end of your Word file, you can (1) select the end of the Word content section and (2) insert the page break like this:

WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak

Your code would then look like this:

Private Sub Export_v1()
    Dim WordApp As Word.Application
    Set WordApp = CreateObject("Word.Application")
    On Error Resume Next
    WordApp.Documents.Add
    WordApp.Visible = True
    
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Shapes.SelectAll
        Selection.Copy

        WordApp.Selection.PasteSpecial DataType:=wdPasteShape
        Application.CutCopyMode = False
        
        WordApp.Selection.EndKey Unit:=wdStory
        WordApp.Selection.InsertBreak
        
    Next ws

End Sub

---

2. Avoiding the same text box to be pasted

If you run the above macro, you'll still get the textbox(s) from the first sheet twice. Why? Because you are using Selection.Copy which is dependent on which sheet is active.

To make sure that the correct sheet is active, simply add ws.Activate before selecting the shapes like this:

Private Sub Export_v2()
    Dim WordApp As Word.Application
    Set WordApp = CreateObject("Word.Application")
    On Error Resume Next
    WordApp.Documents.Add
    WordApp.Visible = True
    
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        ws.Shapes.SelectAll
        Selection.Copy

        WordApp.Selection.PasteSpecial DataType:=wdPasteShape
        Application.CutCopyMode = False
        
        WordApp.Selection.EndKey Unit:=wdStory
        WordApp.Selection.InsertBreak
        
    Next ws

End Sub

---

3. Potential improvements

3.1 Avoid using Select inside Excel

Avoiding using Select in Excel VBA can lead to major speed improvements. However, in this case you can't just replace

ws.Shapes.SelectAll
Selection.Copy

with

ws.Shapes.Copy

as it won't copy the shapes. Instead, you would need to loop through each shape in the worksheet to paste them one by one. This might introduce more complications to your code, so if speed is not an issue, you could keep it as this.

3.2 Reset objects to nothing

To avoid Excel running out of memory, it is a good practice to always reset objects to nothing after you are done using them (at the end of your procedure in this case):

Set WordApp = Nothing