Compléter macro

Bonjour le forum

Je voudrais ajouter une partie de macro sous la forme de la partie existante ci-dessous

Mais

Remplacer 7 par 5

Remplacer 17 par16

    ElseIf Not Intersect(Range("E7"), Target) Is Nothing Then
      If Target = "" Then
        Range("A17").ClearContents           ' Suppression date si SUPPR cellule E7
      Else
        If Range("E17") = Range("E7") Then
          Range("A17") = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))        ' Sinon on inscrit la date
        End If
      End If

    ElseIf Not Intersect(Range("J2"), Target) Is Nothing Then
      ModifTexteLoiAlur Range("G17"), Range("J2")

Dans la macro complète ci-dessous

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date
Dim X, Y

  Application.ScreenUpdating = False
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  ' On recherche si la page est surveillée
  If Left(Sh.Name, 7) = "Charges" Then
    If Not Intersect(Range("B12:B89,E12:E89"), Target) Is Nothing Then

      If Target.Interior.ColorIndex = 2 Then
        ' Si la colonne B et la colonne E est vide on efface la date
        Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("E" & Target.Row) = "", "", Application.Proper(Format(Date, "dddd dd mmmm yyyy")))

      End If
    ElseIf Not Intersect(Range("E7"), Target) Is Nothing Then
      If Target = "" Then
        Range("A17").ClearContents           ' Suppression date si SUPPR cellule E7
      Else
        If Range("E17") = Range("E7") Then
          Range("A17") = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))        ' Sinon on inscrit la date
        End If
      End If

    ElseIf Not Intersect(Range("J2"), Target) Is Nothing Then
      ModifTexteLoiAlur Range("G17"), Range("J2")

      Application.EnableEvents = False
      If Target = "" Then
        Range("G91") = "Montant Annuel Fonds de Travaux Inclus dans Simulation & Solde Charges"
        Joli Range("G91"), 9, 6, 3
        Joli Range("G91"), 33, 6, 3
        Joli Range("G91"), 45, 10, 3
        Joli Range("G91"), 58, 13, 3
      Else
        Range("G91") = "Montant Annuel Fonds de Travaux À Titre Indicatif Cellule E5"
        Joli Range("G91"), 9, 6, 3
        Joli Range("G91"), 33, 17, 3
        Joli Range("G91"), 58, 3, 3
      End If

    ElseIf Not Intersect(Range("J10"), Target) Is Nothing Then
      Application.EnableEvents = False
      If Target = "" Then
        Range("G17") = "Montant Eau Chaude Inclus dans le Calcul Simulation & Solde Charges"
        Range("G17").Font.ColorIndex = 2
        Joli Range("G17"), 1, 7, 3
        Joli Range("G17"), 20, 6, 3
        Joli Range("G17"), 42, 10, 3
        Joli Range("G17"), 55, 13, 3

        Range("G94") = "Montant Annuel Eau Chaude Inclus dans Simulation & Solde Charges"
        Joli Range("G94"), 9, 6, 3
        Joli Range("G94"), 27, 6, 3
        Joli Range("G94"), 38, 11, 3
        Joli Range("G94"), 51, 14, 3
      Else
        Range("G17") = "Montant Eau Chaude Exclu du Calcul Simulation & Solde Charges"
        Range("G17").Font.ColorIndex = 2
        Joli Range("G17"), 1, 7, 3
        Joli Range("G17"), 20, 5, 3
        Joli Range("G17"), 36, 10, 3
        Joli Range("G17"), 49, 13, 3

        Range("G94") = "Montant Annuel Eau Chaude À Titre Indicatif Cellule E7"
        Joli Range("G94"), 9, 6, 3
        Joli Range("G94"), 27, 17, 3
        Joli Range("G94"), 53, 2, 3
      End If
      Application.EnableEvents = True

 'Fin modification du 27/11/2021

    ElseIf Target.Column = 1 And Target.Row > 12 And Target.Interior.ColorIndex = 2 Then
      If IsDate(Target) Then
        Target = Application.Proper(Format(Target, "dddd dd mmmm yyyy"))
      Else
        Target = ""
      End If

    ElseIf Not Intersect(Target, Union(Range("E3"), Range("E8"))) Is Nothing Then
      X = Range("E3").Value
      Y = Range("E8").Value
      If (X <> "") And (Y <> "") Then
       Target.ClearContents
      JouerSon
        MsgBox "Impossible de saisir une valeur dans cellule " & Target.Address(rowabsolute:=False, columnabsolute:=False) & " car cellule " & IIf(Target.Address = "$E$8", "E3", "E8") & " renseigné"
      End If
    End If
    End If
  Application.EnableEvents = True
End Sub
Ça accroche mais je ne sait pas où
Merci à vous pour vos éventuels retours
Cordialement

re le forum

Avec toutes mes excuses il manquait un End if

Cordialement

Bonjour al87

Le titre "compléter macro" n'est pas conforme à la charte

  1. Rédigez soigneusement votre demande et choisissez un titre qui résume bien votre demande.

Vous avez trouvé, tant mieux

Ce post ira à la poubelle d'ici 1 semaine

Rechercher des sujets similaires à "completer macro"