Set ObjectWord = GetObject(, " Word.Application")

'защищает от некоторых, трудно уловимых ошибок
'Option - Вариант
'Explicit - Явный
Option Explicit

'в VBA нажимаем F2, выясняем чему равно значение констант
Const wdCharacter = 1
Const wdLine = 5
'

Sub Main()

    Dim ObjectWord As Object
    Set ObjectWord = GetObject(, "Word.Application")

    'отключаем дёргание экрана при выполнении кода
    ObjectWord.ScreenUpdating = False

    '*********************************************************
    'функция (выясняем место нахождения курсора в таблице)

    'в VBA нажимаем F2, выясняем чему равно значение констант
    Const wdWithInTable = 12
    Const wdEndOfRangeRowNumber = 14
    Const wdEndOfRangeColumnNumber = 17

    Dim isTable As Object
    Set isTable = ObjectWord.Selection.Range

    'условие, если выделено более одной таблицы, тогда ...
    If ObjectWord.Selection.Tables.Count > 1 Then
        MsgBox$ _
                "Программа не может быть продолжена, выделено более одной таблицы", vbOKOnly, _
                "Внимание"
        GoTo Конец
        'условие, если выделеное находится не в таблице, тогда ...
    ElseIf Not isTable.Information(wdWithInTable) Then
        MsgBox$ _
                "Программа не может быть продолжена, курсор должен находится в таблице", vbOKOnly, _
                "Внимание"
        GoTo Конец
    End If

    'номер таблицы в документе, где расположен курсор
    Dim NumberCursorTable As Long
    'номер таблицы в документе, где расположен курсор
    NumberCursorTable = ObjectWord.Range(0, ObjectWord.Selection.Tables(1).Range.End).Tables.Count

    'номер строки в таблице, в документе, где расположен курсор
    Dim NumberCursorRow As Long
    'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые ячейки
    NumberCursorRow = ObjectWord.Selection.Information(wdEndOfRangeRowNumber)

    'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
    Dim NumberCursorCell As Long
    'номер столбца, то есть ячейки в строке таблицы, в документе где расположен курсор, даже если таблица имеет объединённые ячейки
    NumberCursorCell = ObjectWord.Selection.Information(wdEndOfRangeColumnNumber)

    '*********
    '2 вариант

    'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые  ячейки
    'IntegerCursorRow = Selection.Cells(1).RowIndex

    'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
    'IntegerCursorCell = Selection.Cells(1).ColumnIndex
    '*********

    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set isTable = Nothing
    'конец функции (выясняем место нахождения курсора в таблице)
    '*********************************************************

    ObjectWord.Selection.Delete Unit:=wdCharacter, Count:=1

    Dim StrokaInVbscriptRegexp As String
    'здесь при помощи Trim$ откидываем лишние пробелы в начале и в конце строки или ячейки таблицы Word
    StrokaInVbscriptRegexp = Trim$(ObjectWord.Tables(NumberCursorTable).Rows(NumberCursorRow).Cells(NumberCursorCell).Range)
    'Debug.Print StrokaInVbscriptRegexp

    'выполнить функцию с именем ...
    FunctionStrokaInVbscriptRegexp StrokaInVbscriptRegexp

    With ObjectWord.Tables(NumberCursorTable)
        'записать данные ... в ячейку таблицы
        .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Text = StrokaInVbscriptRegexp
        'добавить одну строчку в таблице ниже строки где находится курсор
        ObjectWord.Selection.InsertRowsBelow 1

        'условие, если в ячейке таблицы имеется поле и оно текстовое поле, имеет тип № 70, тогда ...
        If .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields.Count = 1 And _
           .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Type = 70 Then
            'здесь при помощи Trim$ откидываем лишние пробелы в начале и в конце строки или ячейки таблицы Word
            StrokaInVbscriptRegexp = .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Result

            'выполнить функцию с именем ...
            FunctionStrokaInVbscriptRegexp StrokaInVbscriptRegexp

            .Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: " & StrokaInVbscriptRegexp
        Else
            .Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: "
        End If

        'переместить курсор в конец строки
        ObjectWord.Selection.EndKey Unit:=wdLine
    End With

    Beep

Конец:

    'отменяем отключенное ранее дёргание экрана при выполнении кода
    ObjectWord.ScreenUpdating = True

End Sub

Function FunctionStrokaInVbscriptRegexp(StrokaInVbscriptRegexp)

'************************************************************************
'функция (считывание со строки, ячейки таблицы)
'Range со строки или ячейки таблицы Word
'абзац заменяем на пробел
'заменяем два, три, четыре и более пробелов подряд на один пробел
'удаляем концевую сноску таблицы Word
'заменяем пробел, следом идущую запятую на запятую, то есть, удаляем пробел перед запятой
'заменяем двоеточие, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием

    Dim reg As Object
    Set reg = CreateObject("vbscript.regexp")
    'искать по всему тексту, по умолчанию False - будет найдено только первое совпадение
    reg.Global = True
    'Chr$(13) это абзац, заменяем его на пробел
    reg.Pattern = Chr$(13)
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, " ")
    'Debug.Print StrokaInVbscriptRegexp
    '+ означает, что заменяем два, три, четыре и более пробелов подряд на один пробел
    reg.Pattern = " +"
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, " ")
    'Debug.Print StrokaInVbscriptRegexp
    'Chr$(7) это концевая сноска таблицы Word
    reg.Pattern = Chr$(7)
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, "")
    'Debug.Print StrokaInVbscriptRegexp
    'заменяем пробел, следом идущую запятую на запятую, то есть удаляем пробел перед запятой
    reg.Pattern = " ,"
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, ",")
    'Debug.Print StrokaInVbscriptRegexp
    'заменяем пробел, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием
    reg.Pattern = " :"
    StrokaInVbscriptRegexp = reg.Replace$(StrokaInVbscriptRegexp, ":")
    'Debug.Print StrokaInVbscriptRegexp
    StrokaInVbscriptRegexp = Trim$(StrokaInVbscriptRegexp)
    'Debug.Print StrokaInVbscriptRegexp

    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set reg = Nothing
    'конец функции (считывание со строки, ячейки таблицы)
    '***********************************************************************

End Function

 NumberCursorTable = ObjectWord.Range(0, ObjectWord.Selection.Tables(1).Range.End).Tables.Count