Ajout de conditions sur deux macros qui ont la même fonction

Option Explicit
    Const F1 = "BAIE AT10"
    Const lidebF1 = 2
    Const coF1 = "F"
    Const F2 = "DATA SWITCH"
    Const lidebF2 = 2
    Const coF2 = "B"
    Const FR = "SOMMAIRE"
    Const lidebFR = 2
    Const coFRB = "B"
    Const coFRC = "C"
    Const nonOK = "NO BRASS NON AFFECT DON'T CONNECT "
    
Public Sub Ports_Dispo()
    Dim liF As Long, lifinF As Long
    Dim obj As Object
    Dim dico As Object, cle As String, cles, valeurs, nbcles As Long, nucle As Long
    Set dico = CreateObject("scripting.dictionary")
    With Sheets(F1)
        lifinF = .Range(coF1 & Rows.Count).End(xlUp).Row
        For liF = lidebF1 To lifinF
            cle = .Range(coF1 & liF).Value
            If InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR268" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR269" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR270" Then
                If Not dico.exists(cle) Then dico.Add cle, 1
            End If
        Next liF
    End With
    With Sheets(F2)
        lifinF = .Range(coF2 & Rows.Count).End(xlUp).Row
        For liF = lidebF2 To lifinF
            cle = .Range(coF2 & liF).Value
            If InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR268" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR269" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "E") = "EAR270" Then
                If dico.exists(cle) Then
                    dico.Remove (cle)
                Else
                    dico.Add cle, 1
                End If
            End If
        Next liF
    End With
    cles = dico.keys
    valeurs = dico.items
    nbcles = dico.Count
    Sheets(FR).Range(coFRB & lidebFR).Resize(nbcles - 1, 1) = Application.Transpose(cles)
End Sub

Public Sub Ports_Dispo266267()
    Dim derlig As Long
    Dim liF As Long, lifinF As Long
    Dim obj As Object
    Dim dico As Object, cle As String, cles, valeurs, nbcles As Long, nucle As Long
    Set dico = CreateObject("scripting.dictionary")
    With Sheets(F1)
        lifinF = .Range(coF1 & Rows.Count).End(xlUp).Row
        For liF = lidebF1 To lifinF
            cle = .Range(coF1 & liF).Value
            If InStr(1, nonOK, cle) = 0 And .Cells(liF, "A") = "EAR266" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "A") = "EAR267" Then
                If Not dico.exists(cle) Then dico.Add cle, 1
            End If
        Next liF
    End With
    With Sheets(F2)
        lifinF = .Range(coF2 & Rows.Count).End(xlUp).Row
        For liF = lidebF2 To lifinF
            cle = .Range(coF2 & liF).Value
            If InStr(1, cle, nonOK) = 0 And .Cells(liF, "A") = "EAR266" Or InStr(1, nonOK, cle) = 0 And .Cells(liF, "A") = "EAR267" Then
                If dico.exists(cle) Then
                    dico.Remove (cle)
                Else
                    dico.Add cle, 1
                End If
            End If
        Next liF
    End With
    cles = dico.keys
    valeurs = dico.items
    nbcles = dico.Count
    With Sheets(FR)
        .Range(coFRC & lidebFR).Resize(nbcles - 1, 1) = Application.Transpose(cles)
        Application.DisplayAlerts = False
        With Worksheets("SOMMAIRE")
            derlig = .Range("C" & Rows.Count).End(xlUp).Row
            Columns("C:C").Select
            .Range("$C$1:$C$" & derlig).RemoveDuplicates Columns:=1, Header:=xlYes
        End With
        Application.DisplayAlerts = True
    End With
End Sub