найти дату в документе и скопировать в имя файла

На тему сохранения документа с определённым именем я уже отвечал на данном форуме не так давно.
http://wordexpert.ru/forum/viewtopic.php?id=3080
Даже нашёл, special for u.

Поиск осуществляйте с подстановочными символами, тоже тем куча, но вот вам код:

Public Sub lol()
sText = yay
End Sub

Создайте процедуру, как в ветке форума, которую я укзал в начале, и вставьте туда строку sText = yay. Переменная sText будет строкой, которая должна добавляться к имени документа, т.е. имядокумента = Replace(sName, ".docx", "") & sText & ".docx"
Или какой-то ваш формат документа.

Public Function yay()
Dim sPerem As String
Dim sFindStroka As String
sFindStroka = "[0-9]{2}[.][0-9]{2}[.][0-9]{4}"
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .MatchWildcards = True
  Do While .Execute(FindText:=sFindStroka, Forward:=True) = True
    .Execute
    sPerem = Selection.Range.Text: yay = sPerem: Exit Function
  Loop
End With
End Function

Если совсем беда будет с совмещением макросов - пишите.