try this code:

Sub BackupMyFiles()
Dim i, n  As Integer
   
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone


vDirectory = "C:\test\" 'change main directory
vFile = Dir(vDirectory & "\" & "*.do*")
bDirectory = "C:\test\bkup\" '<<< change backup directory


Do While vFile <> ""
Documents.Open FileName:=vDirectory & "\" & vFile
i = 0: n = 0


With ActiveDocument.Content.Find
Do While .Execute(FindText:="Zákaz práce na pozemních komunikacích", Forward:=True, Format:=True, _
   MatchWholeWord:=True) = True
   i = i + 1
Loop


Selection.HomeKey Unit:=wdStory


Do While .Execute(FindText:="Zákaz práce na pozemní komunikaci", Forward:=True, Format:=True, _
   MatchWholeWord:=True) = True
   n = n + 1
Loop


End With
    
ActiveDocument.Close 0


If i > 1 Or n > 1 Then
FileCopy vDirectory & "\" & vFile, bDirectory & "\" & vFile
End If


vFile = Dir
Loop


Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll


MsgBox "Done.."
End Sub
change location of main directory & backup directory..

Cheers!!
excelliot.com