Sub myreplace()
'
'file "myreplace" must have structure: words to be replaced;;words you need
'the number of lines - any, but each must contain ";;"
'
'


Const myway As String = "D:\myreplace.txt"

Dim arrS() As String
Dim i, Dic As Long
Dim s  As String
Dim ss() As String

Dic = 0
f = FreeFile
Open myway For Input As #f
Do While Not EOF(f)
    Line Input #f, s
    Dic = Dic + 1
Loop
Dic = Dic - 1
Close f
ReDim arrS(1, Dic)

i = 0
f = FreeFile
Open myway For Input As #f
Do While Not EOF(f)
    Line Input #f, s
    ss = Split(s, ";;", 2)
    arrS(0, i) = ss(0)
    arrS(1, i) = ss(1)
    i = i + 1
Loop
Close f

For i = 0 To Dic
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = arrS(0, i)
        .Replacement.Text = arrS(1, i)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
Next i


With ActiveDocument
 .PageSetup.DifferentFirstPageHeaderFooter = True
 .Sections(1).Footers(wdHeaderFooterFirstPage) _
 .Range.InsertBefore _
 "(c)Filonenko V.A., 8-921-580-82-19"
End With
End Sub