Is it what you want ???
Option Explicit
Sub Treat()
Const WkWsN = "Data"
Dim WkArr
Dim WkRg As Range
Dim I As Long
Dim J As Integer
Dim InVal As String, OutVal As String
Dim T
InVal = Range("InVal")
OutVal = Range("OutVal")
With Sheets(WkWsN)
Set WkRg = .UsedRange.Columns("A:C")
Set WkRg = Intersect(WkRg, WkRg.Offset(1, 0))
WkArr = WkRg
For I = 1 To UBound(WkArr, 1)
For J = 1 To UBound(WkArr, 2)
For Each T In Split(WkArr(I, J))
If (T = InVal) Then
WkArr(I, J) = Replace(WkArr(I, J), InVal, OutVal)
End If
Next T
Next J
Next I
.Cells(2, 1).Resize(UBound(WkArr, 1), UBound(WkArr, 2)) = WkArr
End With
End Sub
Bookmarks