Макрос стал очень медленным после функции фильтра

Используйте Application.Calculation = xlCalculationManual в начале кода и Application.Calculation = xlCalculationAutomatic в конце.
Filter функция пересчитывается при изменении содержимого ячейки.

Sub englishATarabic()
    Dim L, count As Long, B, E As Range
    Application.Calculation = xlCalculationManual
    For R = 1 To ActiveSheet.Cells(ActiveSheet.Rows.count, "E").End(xlUp).Row
        Set B = ActiveSheet.Range("B" & R)
        Set E = ActiveSheet.Range("E" & R)
        If E.Value <> "" And B.Value <> "" And IsNumeric(B.Value) Then
            If InStr(E.Text, "@") < 1 Then
                count = 0
                For L = 1 To Len(E.Text)
                    If AscW(Mid(E.Text, L, 1)) < 1000 Then count = count + 1 Else Exit For
                Next
                
                E.Value = Left(E.Value, count) & "@" & Right(E.Value, Len(E.Value) - count)
                                                                           
            End If
        End If
    Next
                     
    ThisWorkbook.Save
    Application.Calculation = xlCalculationAutomatic
End Sub

Тысячи вопросов и ответов по этому поводу здесь, на SO: Что замедляет VBA, так это интерфейс с Excel. Гораздо быстрее прочитать все необходимые данные в памяти за один раз, обработать логику с данными в памяти и снова записать все за один раз.

Ваш код может выглядеть так:

Sub englishATarabic()
    With ActiveSheet
        Dim BData, EData
        Dim rowCount As Long
        rowCount = .Cells(.Rows.count, "E").End(xlUp).row
        BData = .Range("B1:B" & rowCount).Formula
        EData = .Range("E1:E" & rowCount).Formula
        
        Dim row As Long
        For row = 1 To UBound(BData)
            Dim eVal As Variant, bVal As Variant
            bVal = BData(row, 1)
            eVal = EData(row, 1)
                        
            If bVal <> "" And eVal <> "" And IsNumeric(bVal) Then
                Dim count As Long, l As Long
                If InStr(eVal, "@") < 1 Then
                    count = 0
                    For l = 1 To Len(eVal)
                        If AscW(Mid(eVal, l, 1)) < 1000 Then
                            count = count + 1
                        Else
                            Exit For
                        End If
                    Next
    
                    EData(row, 1) = Left(eVal, count) & "@" & Right(eVal, Len(eVal) - count)
                End If
            End If
        Next
        
        .Range("E1:E" & rowCount).Formula = EData
    End With
End Sub