Sub Test() Dim p As Page Dim i As Long, idx As Long ActivePage.Shapes.All.Copy Set p = ActiveDocument.AddPages(3) idx = p.Index For i = idx To ActiveDocument.Pages.Count Set p = ActiveDocument.Pages(i) p.Activate p.ActiveLayer.Paste Next iEnd Sub