@הללוהו
תשתמש עם זה
Sub MultipleReplacement()
'GET DATA FROM EXCEL
Dim xlApp As Object
Dim xlBook As Object
Const strWorkBookName As String = "C:\Users\User\Documents\uri.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkBookName)
xlApp.Visible = False
Dim w
w = 1
Do While xlApp.ActiveSheet.range("a" & w) <> ""
strArray = xlApp.ActiveSheet.range("A" & w).Value
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.text = xlApp.ActiveSheet.range("A" & w).Value
.Replacement.text = xlApp.ActiveSheet.range("B" & w).Value
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
w = w + 1
Loop
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
וכמובן לא לשכוח להחליף את הנתיב בשורה 6
בהצלחה