Sub sub2()
    Dim docActive As Document
    Dim tbl As Table
    Dim cel As Cell
    Dim str As String
    Dim shp As Shape
    
    Set docActive = ActiveDocument
    
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    
    For Each shp In ActiveDocument.Sections( 1 ).Footers(wdHeaderFooterPrimary).Shapes
        shp.Select
        Selection.WholeStory
        Selection.Copy
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        Selection.Paste
        'Debug.Print shp.Name
    Next shp

    For Each tbl In docActive.Tables
        For Each cel In tbl.Range.Cells
            strText = Left(cel.Range.Text, Len(cel.Range.Text) -  2 )
            If Len(strText) >  0  Then
                Debug.Print strText
            End If
        Next cel
    Next tbl
    
    For Each tbl In docActive.Tables
        tbl.Delete
    Next tbl
End Sub

Г. 3 . 000 . 0855 /ГТП- 0532 . 505 . 007 . 2 -ЭОО.С
Изм.
Кол.уч.
Лист
№ док.
Подпись
Дата

    For Each cel In docActive.Tables( 2 ).Range.Cells
            strText = Left(cel.Range.Text, Len(cel.Range.Text) -  2 )
            If Len(strText) >  0  Then
                Debug.Print strText
            End If
    Next cel

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

ActiveDocument.Sections( 1 ).Footers(wdHeaderFooterPrimary).Shapes( 1 ).Select
Selection.Tables( 1 ).Cell( 1 ,  7 ).Select
strText = Selection.Tables( 1 ).Cell( 1 ,  7 )
strText = Left(strText, Len(strText) -  2 )
MsgBox (strText)