If ActiveCell.Value Like "*http://*" Or ActiveCell.Value Like "*https://*" Then
Shell "cmd.exe /c " & "start/min" & " " & "iexplore.exe"
End If 

If ActiveCell.Value Like "*http://*" Or ActiveCell.Value Like "*https://*" Then
    Shell "cmd.exe /c " & "Taskkill" & " " & "/f" & " " & "/im" & " " & "iexplore.exe" 
    Shell KMeleonPath & " " & url, vbNormalNoFocus
    Shell "cmd.exe /c " & "Taskkill" & " " & "/f" & " " & "/im" & " " & "iexplore.exe"
Else
Exit Sub
End If

Shell "explorer"
Shell "explorer.exe C:\Windows\win.ini", vbMinimizedFocus

Shell "C:\Program Files (x86)\Internet Explorer\iexplore.exe" & ActiveCell.Value, vbMinimizedFocus 'при 64 разр винде в 2-х местах сидит IE минимизируем окно открытия
Shell "C:\Program Files\Internet Explorer\iexplore.exe" & ActiveCell.Value, vbMinimizedFocus

Shell """" & ThisWorkbook.Path & "\OperaPortable\Opera.exe""" & ActiveCell.Value, vbNormalFocus 'открываем своим браузером

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False

Dim IE As New InternetExplorer
IE.Visible = False

KMeleonPath = """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe"""
Shell (KMeleonPath & " https://google.com"), vbNormalFocus

ВАрианты:

Shell """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe""" & " https://google.com", vbNormalFocus

Shell "C:\KMeleonPortable\k-meleon.exe" & " https://google.com", vbNormalFocus

operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
Shell (operaPath & " -url https://google.com"), vbNormalFocus

KMeleonPath = """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe"""
Shell (KMeleonPath & " -url https://google.com"), vbNormalFocus

KMeleonPath = """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe"""
Shell (KMeleonPath), vbNormalFocus

Shell """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe""" & "https://google.com"

X = Shell("""C:\KMeleonPortable\k-meleon.exe""" & """https://google.com""", vbNormalNoFocus)

Dim Rng1 As Range, Rng2 As Range
With ThisWorkbook.ActiveSheet
Set Rng1 = AutoFilter.Range.Columns(7).SpecialCells(12) 'устанавливаем Rng1 для фильтрованного диапазона в колонке 7
Set Rng2 = AutoFilter.Range.Columns(18).SpecialCells(12) 'устанавливаем Rng2 для фильтрованного диапазона в колонке 18 

End With

Dim Rng1 As Range, Rng2 As Range
'определяем диапазоны Rng1 и Rng2 для условий для видимых ячеек после автофильтра
With ThisWorkbook.ActiveSheet
        Set Rng1 = AutoFilter.Range.Columns(7).SpecialCells(12) 'устанавливаем Rng1 для фильтрованного диапазона в колонке 7
        Set Rng2 = AutoFilter.Range.Columns(18).SpecialCells(12) 'устанавливаем Rng2 для фильтрованного диапазона в колонке 18 

If ActiveSheet.AutoFilter.Filters(7).On Or ActiveSheet.AutoFilter.Filters(18).On Then   'если автофильтр в 7 или 18 столбце включен'и как прописать эти условия ??
If "Значения отфильтрованных ячеек в диапазоне Rng1 одинаковы" And "Все Значения отфильтрованных ячеек в диапазоне Rng1 = "Test""
And "Значения отфильтрованных ячеек в диапазоне Rng2 одинаковы" And "Все Значения отфильтрованных ячеек в диапазоне Rng2 > 0" Then
'Условие1
End If
If "Значения отфильтрованных ячеек в диапазоне Rng1 неодинаковы-несовпают" And "Значения отфильтрованных ячеек в диапазоне Rng2 неодинаковы-несовпают"  Then
'Условие2
End If
 
Else
Exit Sub
 
End With

Dim Rng1 As Range, Rng2 As Range
'определяем диапазоны Rng1 и Rng2 для условий для видимых ячеек после автофильтра
'With ThisWorkbook.ActiveSheet.Range("A1:AH1000").SpecialCells(xlVisible)
'With ThisWorkbook.ActiveSheet.Range("A1:AH1000").SpecialCells(12)
With ThisWorkbook.ActiveSheet
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Rng1 = .Range(.Cells(4, 7), .Cells(LastRow, 7))
   Set Rng2 = .Range(.Cells(4, 18), .Cells(LastRow, 18))


If ActiveSheet.AutoFilter.Filters(7).On Or ActiveSheet.AutoFilter.Filters(18).On Then   'если автофильтр в 7 или 18 столбце включен
'и как прописать эти условия ??
If "Значения отфильтрованных ячеек в диапазоне Rng1 одинаковы" And "Значение отфильтрованных ячеек в диапазоне Rng1 = "Test"" 
And "Значения отфильтрованных ячеек в диапазоне Rng2 одинаковы" And "Значения отфильтрованных ячеек в диапазоне Rng2 > 0" Then
'Условие1
End If
If "Значения отфильтрованных ячеек в диапазоне Rng1 неодинаковы-несовпают" And "Значения отфильтрованных ячеек в диапазоне Rng2 неодинаковы-несовпают"  Then
'Условие2
End If

Else
Exit Sub

End With

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(ActiveCell, Range("C4:C5003")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub

Dim url As String
Dim operaPath As String
 
operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
url = ActiveCell.Value
 
If ActiveCell.Value Like "*http://*" Or ActiveCell.Value Like "*https://*" Then
    Shell operaPath & url, vbNormalNoFocus
    Shell "cmd.exe /c " & "Taskkill" & " " & "/f" & " " & "/im" & " " & "iexplore.exe"
Else
Exit Sub
End If

End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(ActiveCell, Range("C4:С100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub

Dim url As String
Dim operaPath As String

operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
url = ActiveCell.Value

If ActiveCell.Value <> "" Then
Selection.Hyperlinks.Delete
Else
Exit Sub
End If

If ActiveCell.Value Like "*http://*" Or ActiveCell.Value Like "*https://*" Then
'Selection.Hyperlinks.Delete
'Application.Wait Now + TimeSerial(0, 0, 10)

    Shell operaPath & url, vbNormalNoFocus
Else
Exit Sub
End If

End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("C4:C100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub
    If InStr(Target.FormulaLocal, "ГИПЕРССЫЛКА") > 0 Then
    Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & "ГИПЕРССЫЛКА", vbNormalFocus
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("C4:C100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub 
x = Shell("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & """http://www.planetaexcel.ru""", vbNormalNoFocus)
'operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
'Shell (operaPath & " -url http://www.planetaexcel.ru"), vbNormalFocus 
'Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & "http://www.planetaexcel.ru", vbNormalFocus
End If
Exit Sub

Shell "cmd.exe /c " & "Taskkill" & " " & "/f" & " " & "/im" & " " & "chrome.exe"
Shell "cmd.exe /c " & "Taskkill" & " " & "/f" & " " & "/im" & " " & "opera.exe"

Set WshShell = CreateObject("WScript.Shell")
CheckRun = "C:\Windows\System32\notepad.exe"
Set WshExec = WshShell.Exec(CheckRun)
WshExec.Terminate

Set WshShell = CreateObject("WScript.Shell")
CheckRun = """" & ThisWorkbook.Path & "\ChomiumPortable\chrome.exe"""
Set WshExec = WshShell.Exec(CheckRun)
WshExec.Terminate

Public Function LastLongNumber(ByVal this As String) As String
Dim sSymbol As String 'заводим переменную для подсчета общего количества цифр в строке
    If this = "" Then LastLongNumber = "": Exit Function ' если исходная ячейка пустая выходим из функции
    With CreateObject("VBScript.RegExp")
        .Pattern = "[^0-9,]" 'паттерн на все цифры
        sSymbol = .Replace(srcStr, vbNullString) 'вводим в переменную все цифры
        If Len(sSymbol) > 4 Then 'если общее количество цифр в строке >4  - а это значит что длинный номер в конце строки присутствует
        .Pattern = " \d{6,20}$" 'паттерн на длинный номер после пробела в конце текста
        LastLongNumber = Trim$(.Execute(this)(0).Value) ' извлекам номер от 6 до 20 символов после пробела в конце строки
        Else 'иначе выходим из функции
        Exit Function
        End If
    End With
End Function

Public Function LastLongNumber(ByVal this As String) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = " \d{6,20}$"
        LastLongNumber = Trim$(.Execute(this)(0).Value)
    End With
End Function

Function TextOnly(srcStr As String) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        '.Pattern = "[0-9,]" ' так все цифры некорректно удаляет
        .Pattern = " \d{6,20}$" ' все что до  \d{6,20}$
        TextOnly = .Replace(srcStr, vbNullString)
    End With
    Set objRegEx = Nothing
End Function

.Pattern = "^ \d{6,20}$"
 LastLongText = Trim$(.Execute(this)(0).Value)

Function NumbersOnly(srcStr As String) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .Pattern = "[^0-9,]" ' последние цифры нужны после [\s....] пробела
        NumbersOnly = .Replace(srcStr, vbNullString)
    End With
    Set objRegEx = Nothing
End Function
Function TextOnly(srcStr As String) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .Pattern = "[0-9,]" ' все что осталось после [^....]
        TextOnly = .Replace(srcStr, vbNullString)
    End With
    Set objRegEx = Nothing
End Function
Sub TextDoCifr()
ActiveCell.Offset(0, 1).Value = TextOnly(ActiveCell.Text)
End Sub
Sub CifraRight()
ActiveCell.Offset(0, 2).Value = NumbersOnly(ActiveCell.Text)
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    'предварительное форматирование
    Range("A1:Y85").Select
    Selection.NumberFormat = "@"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "обычный"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    'конец предварительное форматирование
    If IsEmpty(Target.Cells(1, 1)) Then
        Target = Empty
    Else
        Target.Copy
        Application.Undo 'ошибка идет
        Target.PasteSpecial xlPasteValues
        Sh.PasteSpecial NoHTMLFormatting:=True
    End If
    Application.EnableEvents = True
End Sub