Problème codes vba

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tx, i%
    tx = Target.Value
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Select Case Target.Address(False, False)
        Case "Mf"
            Btn_MajBase.Visible = (UCase(tx) = "V")
            Btn_ValiderSaisie.Visible = Not (UCase(tx) = "V")
        Case "A29", "A34", "A37", "S10", "S18", "S21", "S34"
            Target = UCase(Left(tx, 1)) & LCase(Mid(tx, 2))
        Case "A4", "K7", "G24"
            Target = UCase(tx)
        Case "K4"
            tx = Split("-" & tx, "-")
            For i = 1 To UBound(tx)
                tx(i) = StrConv(tx(i), vbProperCase)
            Next i
            Target = Replace(Join(tx, "-"), "-", "", 1, 1)
    End Select
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    Call CfnChoix
End Sub

Sub CfnChoix()    'TEST 1
Range("AA2").Value = ""
    If MsgBox("Supprimer cette personne de l'annuaire ?", vbYesNo) = vbYes And MsgBox("Cette personne sera supprimée de l'annuaire !", vbYesNo) = vbYes Then
        Range("AA2").Value = "Sup"
    Else
        Range("AA2").Value = "Maj"
    End If
        CfnMsgBox
End Sub

Sub CfnMsgBox() ‘TEST 2
COULEUR = IIf([AA2] = "Sup", vbRed, vbBlack):  EPAISSEUR = IIf([AA2] = "Sup", xlThick, xlThin)
    With Range("A3:I4,K3:Q4")
        For Each BORDURE In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    With .Borders(BORDURE):  .LineStyle = xlContinuous:  .Weight = EPAISSEUR:  .Color = COULEUR:  End With
        Next BORDURE
    For Each BORDURE In Array(xlDiagonalDown, xlDiagonalUp, xlInsideVertical, xlInsideHorizontal)
        .Borders(BORDURE).LineStyle = xlNone
    Next BORDURE
    End With:  [S4].Select
    End Sub