ShapeRange.Copy

Sub Copy()

The Copy method copies all of the shapes in the range to the Clipboard.

The following code example copies, page by page, all of the shapes from the current document into a new document:

Sub Test() 
 Dim p1 As Page, p2 As Page, bAddPage As Boolean 
 Dim doc1 As Document, doc2 As Document 
 Set doc1 = ActiveDocument 
 Set doc2 = CreateDocument() 
 bAddPage = False 
 Set p2 = doc2.Pages(1) 
 For Each p1 In doc1.Pages 
  p1.Activate 
  p1.Shapes.All.Copy 
  If bAddPage Then Set p2 = doc2.AddPages(1) 
  p2.ActiveLayer.Paste 
  bAddPage = True 
 Next p1 
End Sub