This is code:
On Error Resume Next
Dim oDoc As DrawingDocument
oDoc = ThisApplication.ActiveDocument
Dim oSheetS As Sheets
Dim oPromptEntry
Dim oALLSheet
oCurrentSheet = oDoc.ActiveSheet.Name
i = 1
For Each oSheet In oDoc.Sheets
i = i+1
ThisApplication.ActiveDocument.Sheets.Item(i).Activate
oTitleBlock=oSheet.TitleBlock
oTextBoxes=oTitleBlock.Definition.Sketch.TextBoxes
For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes
Select oTextBox.Text
Case "CONTIENE"
oPromptEntry = oTitleBlock.GetResultText(oTextBox)
End Select
Next
Next
xlsxPath = "C:\Users\castellanos.andres\Desktop\Mass Properties.xlsx"
GoExcel.CellValue(xlsxPath, "Hoja1", "A2:A25")=oPromptEntry
GoExcel.Save
But not to do the loop to get the value of all the sheets