Option Explicit

Const findWhat = "Опасность психических нагрузок, стрессов (при аварийной ситуации)"
Const s2 = "С8 (Ч4 x Т2)"

Sub Заменить()
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    FindInSheet ActiveSheet
    
    Application.Calculation = Application_Calculation
End Sub

Sub FindInSheet(sh As Worksheet)
    With sh.UsedRange
        Dim FoundCell As Range
        Dim LastCell As Range
        Dim FirstAddr As String
        Set LastCell = .Cells(.Rows.Count, .Columns.Count)
        Set FoundCell = .Find(what:=findWhat, after:=LastCell)
         
        If Not FoundCell Is Nothing Then
            FirstAddr = FoundCell.Address
        End If
        Do Until FoundCell Is Nothing
            FoundCellJob FoundCell
            Set FoundCell = .FindNext(after:=FoundCell)
            If FoundCell.Address = FirstAddr Then
                Exit Do
            End If
        Loop
    End With
End Sub
 
Sub FoundCellJob(cl As Range)
    cl.Cells(1, 7).Value = s2
End Sub

If a(r, 1) = "Опасность психических нагрузок, стрессов (при аварийной ситуации)" Then a(r, 7) = "С8 (Ч4 x Т2)"