Hi,

This turned out to be a bit more complicated because shapes are not in the
same layer as inline shapes and text. Anyway this works by converting all the
shapes to inline shapes and then cutting/pasting. I left in the code
(commented out) that converted the shapes back into inline shapes. The issue
with that is that inline shapes float so if you want to use the code you have
to fix the location which I think I have seen you do in this forum.... Also
check where I check for different kinds of shapes by using:

shape1.WrapFormat.Type = wdWrapInline

to see if it works.

Thanks to Chris Weber in this forum who showed how to convert shapes in a
previous post.

old man

Sub c1()
Dim d1 As Document
Dim origdocument As Document
Dim table1 As Table
Dim range1 As Range
Dim range2 As Range
Dim shape1 As Shape
Dim inlineshape1 As InlineShape

   On Error GoTo out1
   Set origdocument = ActiveDocument

   Set d1 = Documents.Add
   Set range2 = d1.Range
   origdocument.Activate

   'do all tables
   For Each table1 In ActiveDocument.Tables
       Set range1 = table1.Range
       range1.Cut
       d1.Activate
     '   range2.Start = d1.Content.End
       Set range2 = ActiveDocument.Range
       range2.Collapse wdCollapseEnd
       
       range2.Paste
       
       Selection.EndKey unit:=wdStory
       Selection.TypeText vbCrLf
       
       origdocument.Activate
       
   Next
   
   'do inlineshapes
   For Each inlineshape1 In ActiveDocument.InlineShapes
       Set range1 = inlineshape1.Range
       range1.Cut
       d1.Activate
     '   range2.Start = d1.Content.End
       Set range2 = ActiveDocument.Range
       range2.Collapse wdCollapseEnd
       
       range2.Paste
       
       Selection.EndKey unit:=wdStory
       Selection.TypeText vbCrLf
       
       origdocument.Activate
         
   Next
   
   'do shapes - convert to inlineshape
   For Each shape1 In ActiveDocument.Shapes
   
     On Error Resume Next
   
     shape1.ConvertToInlineShape
     If Err.Number <> 0 Then
       shape1.WrapFormat.Type = wdWrapInline
       shape1.Anchor.Paragraphs(1).Alignment = wdAlignParagraphCenter
     End If
     
   Next
   
   'reset err handling
   On Error GoTo out1
   
   'now copy to target and convert back to shape
   For Each inlineshape1 In ActiveDocument.InlineShapes
       Set range1 = inlineshape1.Range
       range1.Cut
       d1.Activate
     '   range2.Start = d1.Content.End
       Set range2 = ActiveDocument.Range
       range2.Collapse wdCollapseEnd
       
       range2.Paste
       
       'Selection.WholeStory
     '  Selection.Range.InlineShapes(1).ConvertToShape
       
       Selection.EndKey unit:=wdStory
       Selection.TypeText vbCrLf
       
       origdocument.Activate
         
   Next
   
   Exit Sub
   
out1:
   
   MsgBox "err - " & Err.Description
End Sub

old man