Sub Zamena()
Dim Sht As Worksheet
Dim i As Long
Dim iLastRow As Long
Application.ScreenUpdating = False
    iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For i = 2 To iLastRow
    For Each Sht In Worksheets
      If Sht.Name <> "Замена" Then        ' кроме листа "Замена"
        With Sht
          .Columns("A:F").Replace Cells(i, "A"), Cells(i, "B")
        End With
      End If
    Next
  Next
Application.ScreenUpdating = True
End Sub

Sub ReplacePart()
Dim a, shReplace As Worksheet, sh, i As Long, j As Long, r As Long, oldPart, newPart
Set shReplace = Sheets("Замена")
r = 2
Do
  oldPart = shReplace.Cells(r, 1)
  newPart = shReplace.Cells(r, 2)
  For Each sh In Worksheets
    If sh.Name <> shReplace.Name Then
      With sh
        .Cells.Replace What:=oldPart, Replacement:=newPart, _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
      End With
    End If
  Next
  r = r + 1
Loop Until shReplace.Cells(r, 1) = ""
End Sub

Sub ReplacePart()
Dim a, shReplace As Worksheet, sh, i As Long, j As Long, r As Long, oldPart, newPart
Set shReplace = Sheets("Замена")
r = 2
Do
  oldPart = shReplace.Cells(r, 1)
  newPart = shReplace.Cells(r, 2)
  For Each sh In Worksheets
    If sh.Name <> shReplace.Name Then
      With sh
        .Cells.Replace What:=oldPart, Replacement:=newPart, _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
      End With
    End If
  Next
  r = r + 1
Loop Until shReplace.Cells(r, 1) = ""
End Sub