Valeurs précédentes remplacées par les nouvelles

Le 19/03/2020 à 00:33

Bonjour,

J'ai fait un système de formulaire sans utiliser "USERFORM".

Voici les feuilles misent en places (toutes dans le même classeur):

  • Formulaire
  • Transport
  • Infos patients-clients
  • Calendrier

J'ai réussi à faire que les données du formulaire s'enregistrent dans les 3 feuilles (Transports, Info patients-clients, Calendrier) et à chaque nouvelles infos du formulaire, une nouvelle ligne se créée et ajoute les données.

J'ai juste un problème, avec la feuille "Calendrier". Dès que mon code VAB se met en marche, une nouvelle ligne s'installe avec les nouvelles données du formulaire.

Malheureusement, la ligne précédentes avec les anciennes données sont remplacées avec les nouvelles infos du formulaire.

Voici mon fichier:

42formulaire-version-1-2.xlsm (45.02 Ko)

Pouvez-vous me dire quelles erreurs j'ai pu faire ?

Et quelle est la méthode pour aussi exporter la feuille "Calendrier" en format ".ICS" ?

C'est ou l'intégrer dans un calendrier en ligne, afin de synchroniser les divers rdv sur divers appareils.

Merci par avance pour vos lumières.

Ci-dessous le code VAB:

Sub Sauvegarde()
' transports Macro
    Sheets("Formulaire").Range("A43:T43").Select
    Selection.Copy
    Sheets("Transports").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)

' infos_clients Macro
    Sheets("Formulaire").Select
    Range("K43:S43").Select
    Selection.Copy
    Sheets("Infos patients-clients").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)

' calendrier Macro
    Sheets("Transports").Select
    Range("A3,B3,E3,G3:J3,K3:M3,O3:P3,S3").Select
    Range("S3").Activate
    Selection.Copy
    Sheets("Calendrier").Select
    Range("Tableau3[DATE " & Chr(10) & "TRANSPORT]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Tableau3[DATE " & Chr(10) & "TRANSPORT]").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)

' suppression Macro
    Sheets("Formulaire").Select
    Range("A3:E3").Select
    Selection.ClearContents
    Range("A6:E6").Select
    Selection.ClearContents
    Range("A9:E9").Select
    Selection.ClearContents
    Range("A13:B14").Select
    Selection.ClearContents
    Range("D13:E14").Select
    Selection.ClearContents
    Range("A17:B17").Select
    Selection.ClearContents
    Range("D17:E17").Select
    Selection.ClearContents
    Range("A20:E20").Select
    Selection.ClearContents
    Range("A23:E23").Select
    Selection.ClearContents
    Range("A26:E30").Select
    Selection.ClearContents
    Range("A3").Select
    ActiveWorkbook.Save
End Sub
Le 21/03/2020 à 15:00

Bonjour,

pour garder le fonctionnement présent sur les modules au dessus, vous devriez modifier ceci :

' calendrier Macro
    Sheets("Transports").Select
    Range("A3,B3,E3,G3:J3,K3:M3,O3:P3,S3").Select
    Range("S3").Activate
    Selection.Copy
    Sheets("Calendrier").Select
    Range("Tableau3[DATE " & Chr(10) & "TRANSPORT]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Tableau3[DATE " & Chr(10) & "TRANSPORT]").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)

par :

' calendrier Macro
    Sheets("Transports").Select
    Range("A3,B3,E3,G3:J3,K3:M3,O3:P3,S3").Select
    Range("S3").Activate
    Selection.Copy
    Sheets("Calendrier").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Tableau3[DATE " & Chr(10) & "TRANSPORT]").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)

Ensuite sachez qu'il n'est pas utile voir inutile de sélectionner une cellule pour travailler dessus et qu'il est possible de faire référence à plusieurs cellules on contiguës dans un "Range", donc vous pouvez remplacer ceci :

' suppression Macro
    Sheets("Formulaire").Select
    Range("A3:E3").Select
    Selection.ClearContents
    Range("A6:E6").Select
    Selection.ClearContents
    Range("A9:E9").Select
    Selection.ClearContents
    Range("A13:B14").Select
    Selection.ClearContents
    Range("D13:E14").Select
    Selection.ClearContents
    Range("A17:B17").Select
    Selection.ClearContents
    Range("D17:E17").Select
    Selection.ClearContents
    Range("A20:E20").Select
    Selection.ClearContents
    Range("A23:E23").Select
    Selection.ClearContents
    Range("A26:E30").Select
    Selection.ClearContents
    Range("A3").Select
    ActiveWorkbook.Save

par :

' suppression Macro
    Sheets("Formulaire").Select
    Range("A3:E3,A6:E6,A9:E9,A13:B14,D13:E14,A17:B17,D17:E17,A20:E20,A23:E23,A26:E30").ClearContents
    Range("A3").Select
    ActiveWorkbook.Save

ou encore mieux, sous Excel vous sélectionnez avec la touche [Ctrl] enfoncée, l'ensembles des cellules à effacer du formulaire en lui donnant à l'issue un nom, par exemple Saisie et le code se résume à :

' suppression Macro
    Sheets("Formulaire").Select
    Range("Saisie").ClearContents
    Range("A3").Select
    ActiveWorkbook.Save

@ bientôt

LouReeD

Le 31/03/2020 à 12:41

Bonjour,

Merci beaucoup pour votre retour.

Effectivement, j'ai remarqué qu'il y a trop d'étape dans ce que je fais.

Rechercher des sujets similaires à "valeurs precedentes remplacees nouvelles"