Sub Remplacer()
Dim Corresp As Object, i&, j&, Premier, c As Object, DerLigne&
DerLigne = Sheets("tableau de correspondance").Range("B" & Rows.Count).End(xlUp).Row
Set Corresp = Sheets("tableau de correspondance").Range("A1:B" & _
Sheets("tableau de correspondance").Range("B" & Rows.Count).End(xlUp).Row)
For i = 1 To DerLigne
For j = 1 To Sheets.Count
If Sheets(j).Name <> "tableau de correspondance" Then
With Worksheets(j).UsedRange
Set c = .Find(Corresp(i, 1), LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
Premier = c.Address
Do
c.Value = Corresp(i, 2)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Premier
End If
End With
End If
Next j
Next i
End Sub