XL 2016 Transfère des données réparties sur des lignes à une base de données

[YANNISE]

Salut le Forum,

Pourriez-vous m’aider à développer une macro pour faire copier des données saisies sur un formulaire et les transferts à une base de données au deuxième feuille

L’objectif est de :

Faire copie les données depuis le formulaire (Feuil1) et les recopies sur la base de donne feuil2

Si un champ est vide alors un message d’alerte se déclenche afin de remplir les informations manquantes

Si seulement la première ligne est remplie mais la deuxième non alors les informations résignaient (ligne 1) seront transférés à la BD

À partir d’une macro déjà utilisée dans un autre projet j’ai essayé de l’appliquer sur ce formulaire mais je ne me suis bloqué sur le fait que :

Si la deuxième ligne est non renseignée alors le message d’alerte se déclenche même si la deuxième ligne est vide

Ci-après le code ainsi que le fichier Excel ci joint

Merci d'avance pour l'aide.

Sub ctrl_1()

      Dim Reponse As Byte
      Dim PL As Range, Cel As Range, Lettre$, Message$
      Dim Mavariable As String

      'Mavariable = Feuil1.Range("K9").Value

      Set PL = Feuil1.Range("E3,G3,E6,G6,I6,E9,G9,I9")
      For Each Cel In PL
            Select Case Cel.Address(False, False, xlA1)
                  Case "E3": Lettre = "'Commande'"
                  Case "G3": Lettre = "'Date'"
                  Case "E6": Lettre = "'Article'"
                  Case "G6": Lettre = "'Réf.'"
                  Case "I6": Lettre = "'Matricule'"
                  Case "E9": Lettre = "'Article'"
                  Case "G9": Lettre = "'Réf."
                  Case "I9": Lettre = "'Matricule'"

            End Select
            Select Case Cel.Text
                  Case Is = ""
                        Cel.Interior.Color = RGB(255, 46, 46)
                        If Message = "" Then Message = "Champ(s) non renseigné(s) :  " & vbLf & vbLf & Lettre Else Message = Message & ", " & Lettre
                  Case Else: Cel.Interior.ColorIndex = xlColorIndexNone
                  Range("E59,J59").Interior.Color = RGB(221, 235, 247)
            End Select

      Next Cel

      If Message <> "" Then
            MsgBox Message & vbLf & vbLf & vbLf & "Veuillez saisir le champ signalé (s) ", vbCritical + vbOKOnly, "Erreur de saisie"

      Else

            Feuil2.Range("B9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E3")
            Feuil2.Range("C9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G3")

            Feuil2.Range("D9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E6")
            Feuil2.Range("E9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G6")
            Feuil2.Range("F9999").End(xlUp).Offset(1, 0) = Feuil1.Range("I6")

            Feuil2.Range("B9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E3")
            Feuil2.Range("C9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G3")

            Feuil2.Range("D9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E9")
            Feuil2.Range("E9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G9")
            Feuil2.Range("F9999").End(xlUp).Offset(1, 0) = Feuil1.Range("I9")

            Reponse = MsgBox(vbCr & "    " & "Les données ont bien été enregistrées" & vbCr & " " & vbCr & " " & "Voulez-vous effacer les champs de saisie ?" _
                        , vbInformation + vbYesNo, "Enregistrement effectué...")

            Dim i As Long, k As Long
                With Feuil2
                    k = 1
                    For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
                        If IsNumeric(.Range("A" & i)) And .Range("B" & i) <> "" Then
                        .Range("A" & i) = k
                            k = k + 1
                            Else
                          End If
                        Next i
                    End With
            If Reponse = 6 Then clear_dn_1

            End If

End Sub

 

[YANNISE]

Bonjour YANNISE,

comme te l'a déjà indiqué WarDog, c'est plutôt à éviter de faire du cross posting ! ​

clique sur ce lien bleu : paragraphe 2.10 de la Charte XLD : lis le texte sur fond violet.

---

dans ton énoncé, tu as écrit : « Ci-après le code ainsi que le fichier Excel ci-joint » ; mais tu as oublié de joindre ton fichier Excel ! et j'aimerais bien le voir ! peux-tu modifier ton post #1 pour ajouter ce fichier joint ? pour faire cela, utilise le bouton "Joindre un fichier" qui est situé sous un post en cours d'édition, côté gauche.​

---

as-tu déjà eu une solution à ton exo ? si c'est non, je vais essayer de te trouver une solution (mais c'est sans garantie que je vais en trouver) ; d'un autre côté, même si tu as déjà eu une solution ailleurs et que j'arrive à trouver une solution à ton exo, ça serait étonnant que ma solution sera la même qu'une autre ; et si tu as 2 solutions différentes au lieu d'une, ça peut aussi t'intéresser : tu pourras les comparer et choisir celle que tu préfères. ​

---

@WarDog

tu as écrit dans ton post #2 : « mais je tombe là-dessus à 2 endroits à minima... » ; j'ai bien vu ton post #6, où tu as écrit : « Le sujet semble avoir été pris en main par le modo sur XLP » ; mais tu n'as toujours pas mis de lien sur le post qui, d'après toi, fait l'objet d'un cross-posting, et que tu aurais vu sur le site XLP ou sur d'autres sites ; c'est bien dommage !

d'autre part, tu as écrit dans ton post #2 : « Je veux aider, mais je tombe là-dessus... » ; si vraiment tu veux aider, rien ne t'empêche de poster ta solution si tu en as déjà une, ni de poster plus tard une solution que tu commencerais à chercher maintenant. (et comme les scouts, tu auras fait une BA ! )

au cas où moi-même j'en trouverai une, YANNISE pourra comparer nos 3 solutions ; même si le cross-posting est déconseillé par la Charte, elle n'interdit aucunement à un contributeur de poster une solution s'il en a envie ; de toutes façons, même si YANNISE s'est peut-être désintéressé de son sujet car il aurait déjà trouvé une solution ailleurs qu'ici, la solution que toi ou moi pourront poster ici pourra intéresser tous les lecteurs de cette conversation qui ont le même genre de problème à résoudre que YANNISE. (et dans cette optique, ça rejoint bien la vocation communautaire d'un forum d'entraide tel qu'XLD, qui cherche à aider un maximum de gens)​

soan

bonjour,

Je suis vraiment désolé pour ce conflit inapproprié de ma part.

Vous trouvez ci-joint le fichier demandé

Je m'excuse une autre fois auprès de chacun de vous

 

[soan]

@YANNISE

merci pour tout ce que tu as écrit ton post #11, et merci aussi pour avoir joint ton fichier. ​

soan

 

[YANNISE]

J’ai cherché partout sur une solution ça fait des semaines mais sans résultat pratique

Je crois j’ai le droit de la demander à un autre forum si après des jours j’obtiens aucune réponse !!

 

[Bernard_XLD]

Bonjour YANNISSE, Hasco, soan, le forum

Si seulement la première ligne est remplie mais la deuxième non alors les informations résignaient (ligne 1) seront transférés à la BD

@YANNISE , en limitant le test des champs non remplis déclenchant le message aux deux premières lignes ou une saisie incomplète de la troisième.

Cordialement, @+

Sub ctrl_1()

      Dim Reponse As Byte
      Dim PL As Range, Cel As Range, Lettre$, Message$
      Dim Mavariable As String
     
      'Mavariable = Feuil1.Range("K9").Value
     
      Set PL = Feuil1.Range("E3,G3,E6,G6,I6,E9,G9,I9")
      For Each Cel In PL
            Select Case Cel.Address(False, False, xlA1)
                  Case "E3": Lettre = "'Commande'"
                  Case "G3": Lettre = "'Date'"
                  Case "E6": Lettre = "'Article'"
                  Case "G6": Lettre = "'Réf.'"
                  Case "I6": Lettre = "'Matricule'"
                  Case "E9": Lettre = "'Article'"
                  Case "G9": Lettre = "'Réf."
                  Case "I9": Lettre = "'Matricule'"

            End Select
            Select Case Cel.Text
                  Case Is = ""
                        Cel.Interior.Color = RGB(255, 46, 46)
                        If Message = "" Then Message = "Champ(s) non renseigné(s) :  " & vbLf & vbLf & Lettre Else Message = Message & ", " & Lettre
                  Case Else: Cel.Interior.ColorIndex = xlColorIndexNone
                  Range("E59,J59").Interior.Color = RGB(221, 235, 247)
            End Select
           
      Next Cel

      If Not Application.CountA(Feuil1.Range("E3,G3,E6,G6,I6")) = 5 Or (Application.CountA(Feuil1.Range("E9,G9,I9")) > 0 And Application.CountA(Feuil1.Range("E9,G9,I9")) < 3) Then
            MsgBox Message & vbLf & vbLf & vbLf & "Veuillez saisir le champ signalé (s) ", vbCritical + vbOKOnly, "Erreur de saisie"
           
      Else
     
            Feuil2.Range("B9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E3")
            Feuil2.Range("C9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G3")
           
            Feuil2.Range("D9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E6")
            Feuil2.Range("E9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G6")
            Feuil2.Range("F9999").End(xlUp).Offset(1, 0) = Feuil1.Range("I6")
           
           
            If Application.CountA(Feuil1.Range("E9,G9,I9")) = 3 Then
                Feuil2.Range("B9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E3")
                Feuil2.Range("C9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G3")
           
                Feuil2.Range("D9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E9")
                Feuil2.Range("E9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G9")
                Feuil2.Range("F9999").End(xlUp).Offset(1, 0) = Feuil1.Range("I9")
            End If

            Reponse = MsgBox(vbCr & "    " & "Les données ont bien été enregistrées" & vbCr & " " & vbCr & " " & "Voulez-vous effacer les champs de saisie ?" _
                        , vbInformation + vbYesNo, "Enregistrement effectué...")

            Dim i As Long, k As Long
                With Feuil2
                    k = 1
                    For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
                        If IsNumeric(.Range("A" & i)) And .Range("B" & i) <> "" Then
                        .Range("A" & i) = k
                            k = k + 1
                            Else
                          End If
                        Next i
                    End With
            If Reponse = 6 Then clear_dn_1
   
            End If
           
End Sub

 

[YANNISE]

Bonjour @Bernard_XLD ;

d'abord je te remercie infiniment de votre intervinssent ainsi que @soan et je m'excuse auprès de vous tous

notamment je te remercie pour le code il est parfait juste il manque un petit truc :

si le premier ligne est renseigné mais le second est entièrement vide alors après l'enregistrement des données du ligne 1 les cellules de 2eme ligne ne devraient pas apparaître en couleur rouge
peut tu STP voir ca

grand merci

 

[Bernard_XLD]

Bonjour YANNISE, le fil, le forum

Une petite modif rapide !

Sub ctrl_1()

      Dim Reponse As Byte
      Dim PL As Range, Cel As Range, Lettre$, Message$
      Dim Mavariable As String
    
      'Mavariable = Feuil1.Range("K9").Value
    
      Set PL = Feuil1.Range("E3,G3,E6,G6,I6")
      For Each Cel In PL
            Select Case Cel.Address(False, False, xlA1)
                  Case "E3": Lettre = "'Commande'"
                  Case "G3": Lettre = "'Date'"
                  Case "E6": Lettre = "'Article'"
                  Case "G6": Lettre = "'Réf.'"
                  Case "I6": Lettre = "'Matricule'"

            End Select
            Select Case Cel.Text
                  Case Is = ""
                        Cel.Interior.Color = RGB(255, 46, 46)
                        If Message = "" Then Message = "Champ(s) non renseigné(s) :  " & vbLf & vbLf & Lettre Else Message = Message & ", " & Lettre
                  Case Else: Cel.Interior.ColorIndex = xlColorIndexNone
                  Range("E59,J59").Interior.Color = RGB(221, 235, 247)
            End Select
          
      Next Cel
      If Application.CountA(Feuil1.Range("E9,G9,I9")) > 0 Then
          Set PL = Feuil1.Range("E9,G9,I9")
          For Each Cel In PL
                Select Case Cel.Address(False, False, xlA1)
                      Case "E9": Lettre = "'Article 2'"
                      Case "G9": Lettre = "'Réf. 2'"
                      Case "I9": Lettre = "'Matricule 2'"
    
                End Select
                Select Case Cel.Text
                      Case Is = ""
                            Cel.Interior.Color = RGB(255, 46, 46)
                            If Message = "" Then Message = "Champ(s) non renseigné(s) :  " & vbLf & vbLf & Lettre Else Message = Message & ", " & Lettre
                      Case Else: Cel.Interior.ColorIndex = xlColorIndexNone
                      Range("E59,J59").Interior.Color = RGB(221, 235, 247)
                End Select
              
          Next Cel
      End If

      If Not Application.CountA(Feuil1.Range("E3,G3,E6,G6,I6")) = 5 Or (Application.CountA(Feuil1.Range("E9,G9,I9")) > 0 And Application.CountA(Feuil1.Range("E9,G9,I9")) < 3) Then
            MsgBox Message & vbLf & vbLf & vbLf & "Veuillez saisir le champ signalé (s) ", vbCritical + vbOKOnly, "Erreur de saisie"
          
      Else
    
            Feuil2.Range("B9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E3")
            Feuil2.Range("C9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G3")
          
            Feuil2.Range("D9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E6")
            Feuil2.Range("E9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G6")
            Feuil2.Range("F9999").End(xlUp).Offset(1, 0) = Feuil1.Range("I6")
          
          
            If Application.CountA(Feuil1.Range("E9,G9,I9")) = 3 Then
                Feuil2.Range("B9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E3")
                Feuil2.Range("C9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G3")
          
                Feuil2.Range("D9999").End(xlUp).Offset(1, 0) = Feuil1.Range("E9")
                Feuil2.Range("E9999").End(xlUp).Offset(1, 0) = Feuil1.Range("G9")
                Feuil2.Range("F9999").End(xlUp).Offset(1, 0) = Feuil1.Range("I9")
            End If

            Reponse = MsgBox(vbCr & "    " & "Les données ont bien été enregistrées" & vbCr & " " & vbCr & " " & "Voulez-vous effacer les champs de saisie ?" _
                        , vbInformation + vbYesNo, "Enregistrement effectué...")

            Dim i As Long, k As Long
                With Feuil2
                    k = 1
                    For i = 2 To .Range("B" & .Rows.Count).End(xlUp).Row
                        If IsNumeric(.Range("A" & i)) And .Range("B" & i) <> "" Then
                        .Range("A" & i) = k
                            k = k + 1
                            Else
                          End If
                        Next i
                    End With
            If Reponse = 6 Then clear_dn_1
  
            End If
          
End Sub

 

[YANNISE]

Super merci beaucoup

 

[Bernard_XLD]

Super merci beaucoup

De rien, au plaisir de vous revoir sur le forum !
N'oubliez pas, avant vos futures demandes, de consulter la charte Xld si vous ne l'avez pas déjà fait.
Je vous souhaite une excellente soirée.

Bien cordialement, @+
Bernard_XLD

 

[YANNISE]

C’est noté, mercii

Également

 

[soan]

Bonjour YANNISE, Bernard,

* regarde "Feuil2" : note que tout est vide, à part les en-têtes de la ligne 1.

---

* va sur "Feuil1" ; tu peux voir qu'il n'y a pas de données ; note que la cellule active est J13 ; clique sur le bouton "Archiver" ou fais Ctrl t (t pour transfert en "Feuil2") ; ça refuse de faire le transfert car il manque plusieurs données, et la 1ère donnée manquante est la référence de la Commande ; non seulement tu as un message du contrôle de saisie, mais en plus, la cellule active est maintenant E3 ➯ c'est prêt pour que tu saisisses la référence de la Commande.

* saisis "a" et valide ; fais Ctrl t ; y'a aucun changement ! c'est normal : relis bien le message, y compris la fin qui est entre parenthèses ; vu ? donc maintenant, saisis "CMD12" ; fais Ctrl t ; là aussi : transfert refusé ; c'est car il manque une Date ; lis le nouveau message ; saisis "a" ; Ctrl t ; aucun changement, car "a" n'est pas une date valide ! donc le contrôle des saisies fonctionne bien ! saisis "19/6" ➯ 19/06/2022 ; Ctrl t ; transfert refusé ; c'est car il manque la référence d'un Article ; la cellule active est E6.
​

---

* pour Ligne 1, l'Article est obligatoire, car une commande sans aucun article n'a pas de sens ! saisis "ART1254" ; fais Ctrl t ; ça va en G6 car c'est là qu'il faut saisir la donnée manquante suivante : Réf. ; saisis "RF223311" ; fais Ctrl t ; ça va en i6 car il faut saisir le Matricule ; saisis "654125".

* pour Ligne 2, tu n'as encore rien saisi pour l'Article ; or il est facultatif ; la preuve : fais Ctrl t et lis le nouveau message ; va voir sur "Feuil2" ; ainsi donc, c'est possible de traiter un seul article de la commande : le 2ème est bien facultatif ; comme c'est une démo, sélectionne A2:F2 et appuie sur la touche Suppression ; bien sûr, ça a effacé les données de la ligne 2 ; sélectionne A1 puis va en "Feuil1".

* c'est resté pareil qu'avant de faire Ctrl t ; sélectionne E9 ; saisis "a" ; Ctrl t ; lis le message ; saisis "ART1255" ; Ctrl t ; ça va en G9 ; eh oui, hein ? à partir du moment où y'a un Article en E9, la Réf. correspondante est obligatoire ! saisis "RF223312" ; Ctrl t ; ça va en i9 ; même chose : le Matricule est obligatoire pour la même raison ! saisis "978456" ; cette fois, le masque de saisie est plein : on a saisi toutes les données ; Ctrl t ➯ transfert de la commande de 2 articles effectué ; va le vérifier en "Feuil2", puis reviens sur "Feuil1".
​

---

* fais Ctrl c ➯ ça efface toutes les données du masque de saisie, et ça va en E3 pour saisir une nouvelle commande ; saisis "CMD15" ; sélectionne G3 ; saisis "19/6" ; va en E6 ; saisis "ART255" ; en G6 : "RF21551" ; en i6 : "654258" ; va en E9 ; saisis "ART3355" ; en G9 : "RF336654" ; en i9 : "785463" ; tu auras remarqué que tu n'as pas eu besoin de faire Ctrl t comme pour la 1ère Commande ; c'est car on le faisais juste pour tester les contrôles de saisie, et car c'est une démo ; mais en fait, tu n'as besoin de faire Ctrl t qu'une seule fois quand tu as terminé la saisie de toutes les données du masque de saisie (avec ou sans le 2ème Article facultatif) ; pour notre 2ème Commande en cours qu'on viens de terminer, fais Ctrl t ; va en "Feuil2" ; tout a bien été enregistré : la 2ème Commande est sous la 1ère Commande ➯ on a bien nos 2 commandes de 2 articles chacune, donc 4 articles en tout.
​

---

j'espère que tu as remarqué que c'est beaucoup plus simple sans boîtes de dialogues via MsgBox, car ça t'évite de devoir cliquer à chaque fois sur le bouton OK pour quitter le message d'avertissement d'un contrôle de donnée ; pour tes couleurs comme par exemple le rouge, je ne l'ai pas fait pour que ça reste sobre ; ce n'est pas par oubli ; et tu as pu constater qu'on peut s'en passer ; mais si tu y tiens, tu peux mettre une bordure et une couleur de remplissage pour la fusion de cellules D13:H13, car c'est là que sont affichés les divers messages ; exemple : contour noir et remplissage bleu clair.

fin de la démo, j'espère que ça t'a plu ! tu n'as plus qu'à étudier le code VBA ! si besoin, tu peux demander une adaptation ; merci de me donner ton avis. ​

---

code VBA de Module1 (81 lignes) :

Option Explicit

Dim cel As Range, flg As Byte

Sub Msg(k As Byte, Optional n As Byte)
  flg = 0
  If k = 2 Then
    If IsDate(cel) And cel Like "##/##/####" Then Exit Sub
    [D13] = "Veuillez saisir une Date valide."
    cel.Select: flg = 1: Exit Sub
  End If
  If Len(cel) >= n Then Exit Sub
  Dim s1$, s2$: cel.Select: flg = 1
  Select Case k
    Case 1: s2 = "Commande"
    Case 3, 6: s2 = "Article"
    Case 4, 7: s2 = "Réf."
    Case 5, 8: s2 = "Matricule"
  End Select
  If k > 2 Then
    s1 = "Ligne 1 ; ": If k > 5 Then Mid$(s1, 7, 1) = "2"
  End If
  [D13] = s1 & "Veuillez saisir le champ " & s2 _
    & " (" & n & " caractères minimum)"
End Sub

Private Sub DataCtrl()
    Application.ScreenUpdating = 0: [D13] = "": flg = 0
                    Set cel = [E3]: Msg 1, 4  'Commande    ex : "CMD1"
    If flg = 0 Then Set cel = [G3]: Msg 2     'Date        ex : "18/06/2022"
    If flg = 0 Then Set cel = [E6]: Msg 3, 4  'Article1    ex : "ART1"
    If flg = 0 Then Set cel = [G6]: Msg 4, 3  'Réf1        ex : "RF1"
    If flg = 0 Then Set cel = [I6]: Msg 5, 6  'Matricule1  ex : "123456"
  'Ligne 2 : le 2ème article de cette ligne est facultatif
  If [E9] = "" Then 'Article : non
    '1) ni Réf. ni Matricule : article facultatif => OK !
    If [G9] = "" And [I9] = "" Then Exit Sub
    '2) si y'a Réf. ou Matricule : aller en E9 car 2ème Article vide !
    If [G9] <> "" Or [I9] <> "" Then
      [D13] = "Veuillez saisir le 2ème Article (4 caractères minimum)"
      [E9].Select: Exit Sub
    End If
  Else 'Article : oui
                    Set cel = [E9]: Msg 6, 4  'Article2    ex : "ART1"
    If flg = 0 Then Set cel = [G9]: Msg 7, 3  'Réf2        ex : "RF1"
    If flg = 0 Then Set cel = [I9]: Msg 8, 6  'Matricule2  ex : "123456"
  End If
End Sub

Private Sub Job1(lig&)
  With Feuil2.Cells(lig, 1)
    .Value = lig - 1     'N° ligne
    .Offset(, 1) = [E3]  'Commande
    .Offset(, 2) = [G3]  'Date
  End With
End Sub

Private Sub Job2(Art$, Réf$, Mat$, lig&)
  With Feuil2.Cells(lig, 4)
    .Value = Art         'Article
    .Offset(, 1) = Réf   'Réf
    .Offset(, 2) = Mat   'Matricule
  End With
End Sub

Private Sub DataCpy()
  Dim lig&: Application.ScreenUpdating = 0
  lig = Feuil2.Cells(Rows.Count, 1).End(3).Row + 1
  Job1 lig 'pour Article1 : Numéro ; Commande ; Date
  Job2 [E6], [G6], [I6], lig 'Article1 de Ligne 1
  If [E9] <> "" Then lig = lig + 1 Else GoTo 1
  Job1 lig 'pour Article2 : Numéro ; Commande ; Date
  Job2 [E9], [G9], [I9], lig 'Article2 de Ligne 2
1 [D13] = "Les données ont bien été enregistrées."
End Sub

Sub Archiver()
  If ActiveSheet.CodeName <> "Feuil1" Then Exit Sub
  Call DataCtrl: If flg = 0 Then DataCpy
End Sub

---

code VBA de Module2 (7 lignes) :

Option Explicit

Sub Effacer() 'en Feuil1, efface les données saisies et le message
  Application.ScreenUpdating = 0: Feuil1.[E3].Select
  Feuil1.Range("E3,G3, E6,G6,I6, E9,G9,I9, D13:H13").ClearContents
End Sub

soan

 

[YANNISE]

Bonjour @soan ;

merci bien pour le code tré intéressant ainsi pour ce travail remarquable

ca donne des d'idées

un grand merci encore une fois pour cette effort

 

[soan]

@YANNISE : je suis vraiment ravi que tu as apprécié ma solution !