Sub WorkbookFindAndReplace()
Dim sourceWorksheet As Worksheet
Dim currentWorksheet As Worksheet
Dim findAndReplaceRange As Range
Dim searchFor As String
Dim replaceWith As String
Dim lastRow As Long
Dim i As Long
On Error Resume Next
Set sourceWorksheet = ActiveWorkbook.Worksheets("Sheet1")
If sourceWorksheet Is Nothing Then
MsgBox "The source worksheet was not found!", vbExclamation
Exit Sub
End If
On Error GoTo 0
With sourceWorksheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set findAndReplaceRange = .Range("A1:B" & lastRow)
End With
For i = 1 To findAndReplaceRange.Rows.Count
searchFor = findAndReplaceRange(i, 1).Value
If Len(searchFor) > 0 Then
replaceWith = findAndReplaceRange(i, 2).Value
For Each currentWorksheet In ActiveWorkbook.Worksheets
If currentWorksheet.Name <> sourceWorksheet.Name Then
WorksheetFindAndReplace currentWorksheet, searchFor, replaceWith
End If
Next currentWorksheet
End If
Next i
End Sub
Sub WorksheetFindAndReplace(ByVal currentWorksheet As Worksheet, ByVal searchFor As String, ByVal replaceWith As String)
Dim foundCell As Range
With currentWorksheet.Cells
Set foundCell = .Find(What:=searchFor, LookIn:=xlFormulas, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=True)
If Not foundCell Is Nothing Then
Do
foundCell.Value = replaceWith
Set foundCell = .FindNext(foundCell)
Loop Until foundCell Is Nothing
End If
End With
End Sub