What is the fastest most efficient way to find and replace things in cells?

Hi, I am searching for a certain word in a sheet of thousands of cells and replacing it with another. I have tried to do both for each cell in the range and find and replace but they both take a while. Is there a more efficient faster way to do this? Thank You

Sub UpdateAirnRail()
Application.ScreenUpdating = False

Dim countriesup As String
countriesup = ThisWorkbook.Sheets("Data").Range("B3").Value

stopped = False
UserForm.Show

'copy and paste for Data

Workbooks(namess).Sheets("Transaction Reporting").Activate
With ActiveSheet

Dim lr As Long
Dim lc As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column

    Range(Cells(1, 1), Cells(lr, lc)).AutoFilter

    ActiveSheet.Range(Cells(1, 1), Cells(lr, lc)).AutoFilter Field:=1, Criteria1:=countriesup
    Range(Cells(2, 1), Cells(lr, 3)).SpecialCells(xlCellTypeVisible).Copy
    ThisWorkbook.Sheets("data").Range("B3").PasteSpecial xlPasteValues
    Range(Cells(2, 6), Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy
    ThisWorkbook.Sheets("data").Range("E3").PasteSpecial xlPasteValues

End With

'delete adjustment for Data

ThisWorkbook.Sheets("Data").Activate


With ActiveSheet

Dim lrs As Long
lrs = Cells(Rows.Count, 2).End(xlUp).Row


For Each Cell In Range("C3:C" & lrs)
    If Cell.Value = "Adjustment to get to Market P&L Transactions" Then
    Rows(Cell.Row).Delete
    End If
Next Cell

ActiveSheet.Calculate


End With

'copy and paste for status

Workbooks(namess).Sheets("Status_Official").Activate
With ActiveSheet

Dim lr2 As Long
Dim lc2 As Long
lr2 = Cells(Rows.Count, 1).End(xlUp).Row
lc2 = Cells(1, Columns.Count).End(xlToLeft).Column

    Range(Cells(1, 1), Cells(lr2, lc2)).AutoFilter
    ActiveSheet.Range(Cells(1, 1), Cells(lr2, lc2)).AutoFilter Field:=1, Criteria1:=countriesup
    Range(Cells(2, 1), Cells(lr2, 3)).SpecialCells(xlCellTypeVisible).Copy
    ThisWorkbook.Sheets("status").Range("B3").PasteSpecial xlPasteValues
    Range(Cells(2, 6), Cells(lr2, lc2)).SpecialCells(xlCellTypeVisible).Copy
    ThisWorkbook.Sheets("status").Range("E3").PasteSpecial xlPasteValues

End With

'Delete adjustment for status

ThisWorkbook.Sheets("Status").Activate

With ActiveSheet

Dim lrss As Long
lrss = Cells(Rows.Count, 2).End(xlUp).Row
lcss = Cells(5, Columns.Count).End(xlToLeft).Column


For Each Cell In Range("C3:C" & lrss)
    If Cell.Value = "Adjustment to get to Market P&L Transactions" Then
    Rows(Cell.Row).Delete
    End If
Next Cell
Range(Cells(3, 5), Cells(lrss, lcss)).Replace What:="Potential Loss", Replacement:="works", LookAt:=xlPart


End With

Application.ScreenUpdating = True

This is my macro, it does more things updating a bunch of stuff. And it is about 300k cells.