Sub uuu()
     Application.ScreenUpdating = False
     With Sheets("переименование")
         a = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
     End With
     With Sheets("список")
     Set sd = CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(a)
             If a(i, 1) <> "" And a(i, 1) <> "заменить на" Then
                 sd.Item(a(i, 1)) = a(i + 1, 2)
             End If
         Next
         For rw = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
             If sd.Exists(CDbl(.Cells(rw, 1))) Then
                 .Cells(rw, 3) = sd.Item(CDbl(.Cells(rw, 1)))
             End If
         Next
     End With
     Application.ScreenUpdating = True
End Sub

Sub uuu()
     Application.ScreenUpdating = False
     For rw1 = 2 To Sheets("список").Cells(Rows.Count, 1).End(xlUp).Row
         With Sheets("переименование")
             For rw2 = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
                 If .Cells(rw2, 1) <> "" And .Cells(rw2, 1) <> "заменить на" Then
                     If Sheets("список").Cells(rw1, 1) = .Cells(rw2, 1) Then
                         .Cells(rw2, 3) = Sheets("список").Cells(rw1, 2)
                         Sheets("список").Cells(rw1, 2) = .Cells(rw2 + 1, 2)
                         Exit For
                     End If
                 End If
             Next
         End With
     Next
     Application.ScreenUpdating = True
End Sub