How can I move an existing shape to a specific page?

[ADAL]

Subject: How to Move an Existing Linked Textbox (Shape) to a Specific Page Without Breaking Links?

Hi everyone,

I have a Word document with multiple linked textboxes (Shapes) that are connected to each other. I would like to create a macro to place:

The textbox named TB1 on page 1,
The textbox named TB2 on page 2,
And so on.
The problem is that I cannot create a new textbox in the desired range because doing so breaks the link between the existing textboxes.


My main question is: How can I move an existing shape (textbox) to a specific page without creating a new one?
And to save time for the respondents, I would like to mention, a common mistake, that propety anchor is read only, so i can't do something like:
shp.anchor = rangeX
Any help or guidance would be greatly appreciated!

Thank you!

[Logit]

Steps:
Select the Linked Textbox:

Click on the edge of the textbox (shape) to select it.
Cut the Textbox:

Press Ctrl + X to cut the textbox.
Navigate to the Target Page:

Scroll to the desired page in your worksheet.
Paste the Textbox:

Press Ctrl + V to paste the textbox in the desired location.
Drag it to adjust its position on the page as needed.
Verify Links Are Intact:

The link should remain functional because cutting and pasting within the same workbook doesn’t break links.
Check Page Layout (Optional):

If you're working in Page Layout View, ensure the textbox appears correctly by toggling between views:
View tab → Select Page Layout.

[ADAL]

Hello, thanks for the answer but there are 2 problems here:
1. I need to make a macro, not manually (it's a file with hundreds of pages, and text boxes).
2. As I wrote, cutting breaks the link (this is not a hypothesis, I checked it)

[macropod]

You might try something like:

Sub RelocateTextBoxes()
Application.ScreenUpdating = False
Dim Doc As Document, i As Long, s As Long, v As Long, x As Long, Rng As Range, ArrShp() As String
Set Doc = ActiveDocument: ReDim ArrShp(0)
With Doc
  v = .ActiveWindow.View.Type: .ActiveWindow.View.Type = wdOutlineView
  For s = 1 To .Shapes.Count
    If Left(.Shapes(s).Name, 2) = "TB" Then
      i = i + 1: ReDim Preserve ArrShp(i): ArrShp(i) = Format(Split(.Shapes(s).Name, "TB")(1), "000")
    End If
  Next
  WordBasic.SortArray ArrShp()
  For s = 1 To UBound(ArrShp)
    i = CLng(ArrShp(s))
    With .Shapes("TB" & i)
      Set Rng = Doc.GoTo(What:=wdGoToPage, Name:=i)
      If s > 1 Then
        If Rng.Start < Doc.Shapes("TB" & i - 1).Anchor.End Then Rng.Start = Doc.Shapes("TB" & i - 1).Anchor.End
      End If
      x = -(Rng.Start < .Anchor.Start) '1= wdRelocateDown, 0 = wdRelocateUp
      If Rng.Start < .Anchor.Start Then
        Rng.End = .Anchor.Start - 1: Rng.Relocate Direction:=x
      Else
        Rng.Start = .Anchor.End + 1: Rng.Relocate Direction:=x
      End If
    End With
  Next
  .ActiveWindow.View.Type = v
End With
Application.ScreenUpdating = True
End Sub