XL 2019 Création de formulaire

[JFR]

Bonjour,
J'aurai besoin de votre aide encore une fois.
Je souhaiterais à partir de mon onglet "création" remplir la cases correspondantes pour me générer le document dans l'onglet suivent.
La cerise sur le gâteau serait que le formulaire mémorise le dernier numéro de CR qui commence toujours par CR ***/2026 (numéro et année) pour générer automatiquement le numéro du document suivant

Merci à tous pour votre aide

 

[Xl60PassionFr]

Bonjour JFR

Code à mettre dans un module 😉

Sub CréationFiche()
  Dim Ind As Integer, TabRngSce() As String, TabRngDes() As String
  ' Définir les cellules source
  TabRngSce = Split("A2,A6,C6,E6,G6,A9,C9,A13", ",")
  ' Définir les cellules de destination
  TabRngDes = Split("C17,C14,A23,E23,G23,C29,C34,A38", ",")
  ' Avec ce classeur
  With ThisWorkbook
    ' Boucler sur chque cellules
    For Ind = 0 To UBound(TabRngSce)
      ' Inscrire les valeur
      .Worksheets("Document").Range(TabRngDes(Ind)).Value = .Worksheets("Création").Range(TabRngSce(Ind)).Value
    Next Ind
    ' Mémoriser le dernier n° de CR
    .Worksheets("Création").Range("L1").Value = .Worksheets("Création").Range("A6").Value
    ' Afficher la feuille remplie
    .Worksheets("Document").Activate
    ' Demander si on efface le formulaire
    If MsgBox("Remttre à zéro le formualire ?", vbQuestion + vbYesNo, "QUESTION..") = vbYes Then
      ' Boucler sur chque cellules
      For Ind = 0 To UBound(TabRngSce)
        .Worksheets("Création").Range(TabRngSce(Ind)).Value = ""
      Next Ind
    End If
  End With
End Sub

Edit : code modifié suite à la demande #5

A+

 

[Piment]

Bonjour,
J'aurai besoin de votre aide encore une fois.
Je souhaiterais à partir de mon onglet "création" remplir la cases correspondantes pour me générer le document dans l'onglet suivent.
La cerise sur le gâteau serait que le formulaire mémorise le dernier numéro de CR qui commence toujours par CR ***/2026 (numéro et année) pour générer automatiquement le numéro du document suivant

Merci à tous pour votre aide

Bonjour à tous,
JFR, perso, je n'ai rien compris à votre demande. Si vous voulez envoyer les données de la feuille "Création" dans la feuille "Document", il vous suffit de mettre "=" dans la feuille "Document". Exemple : "C14" de la feuille "Document" est "=" A6" de la feuille "Création". Il n'y a pas besoin de macro pour faire cela !
Je pense qu'il vous faut nous dire ce que vous voulez faire en nous mettant un fichier qui se rapproche le plus de votre fichier original.
Cordialement.

 

[JFR]

Bonjour JFR

Code à mettre dans un module 😉

Sub CréationFiche()
  Dim Ind As Integer, TabRngSce() As String, TabRngDes() As String
  ' Définir les cellules source
  TabRngSce = Split("A2,A6,C6,E6,G6,A9,C9,A13", ",")
  ' Définir les cellules de destination
  TabRngDes = Split("C17,C14,A23,E23,G23,C29,C34,A38", ",")
  ' Avec ce classeur
  With ThisWorkbook
    ' Boucler sur chaque cellule
    For Ind = 0 To UBound(TabRngSce)
      ' Inscrire les valeur
      .Worksheets("Document").Range(TabRngDes(Ind)).Value = .Worksheets("Création").Range(TabRngSce(Ind)).Value
    Next Ind
    ' A la fin, mémoriser le dernier n° de CR
    .Worksheets("Création").Range("L1").Value = .Worksheets("Création").Range("A6").Value
  End With
End Sub

A+

Bonjour,
Je vous remercie

Bonjour à tous,
JFR, perso, je n'ai rien compris à votre demande. Si vous voulez envoyer les données de la feuille "Création" dans la feuille "Document", il vous suffit de mettre "=" dans la feuille "Document". Exemple : "C14" de la feuille "Document" est "=" A6" de la feuille "Création". Il n'y a pas besoin de macro pour faire cela !
Je pense qu'il vous faut nous dire ce que vous voulez faire en nous mettant un fichier qui se rapproche le plus de votre fichier original.
Cordialement.

Bonjour,

Je souhaite rentrer les données dans la partie "création" qui vont aller directement compléter la partie "document". Faire du si ou = n'est pas l'idéal dans ce cas. Je souhaite en cliquant sur "création" l'enregistrement se fait dans "document" et que la feuille création redevienne vierge.
Concernant la partie "document" la mise en page sera finalisée plus tard

 

[JFR]

Bonjour JFR

Code à mettre dans un module 😉

Sub CréationFiche()
  Dim Ind As Integer, TabRngSce() As String, TabRngDes() As String
  ' Définir les cellules source
  TabRngSce = Split("A2,A6,C6,E6,G6,A9,C9,A13", ",")
  ' Définir les cellules de destination
  TabRngDes = Split("C17,C14,A23,E23,G23,C29,C34,A38", ",")
  ' Avec ce classeur
  With ThisWorkbook
    ' Boucler sur chaque cellule
    For Ind = 0 To UBound(TabRngSce)
      ' Inscrire les valeur
      .Worksheets("Document").Range(TabRngDes(Ind)).Value = .Worksheets("Création").Range(TabRngSce(Ind)).Value
    Next Ind
    ' A la fin, mémoriser le dernier n° de CR
    .Worksheets("Création").Range("L1").Value = .Worksheets("Création").Range("A6").Value
  End With
End Sub

A+

Merci beaucoup.
Il me manque le fait qu'une fois le clic sur "création" se fait, le document ne redevient pas vierge pour une prochaine saisie. Je sais que j'abuse lol

 

[Xl60PassionFr]

Re,

Mon code ne #2 est modifié

XL 2019 Publié dans la discussion 'Création de formulaire'

Aujourd'hui à 13:37

Bonjour JFR

Code à mettre dans un module 😉

Sub CréationFiche()
  Dim Ind As Integer, TabRngSce() As String, TabRngDes() As String
  ' Définir les cellules source
  TabRngSce = Split("A2,A6,C6,E6,G6,A9,C9,A13", ",")
  ' Définir les cellules de destination
  TabRngDes = Split("C17,C14,A23,E23,G23,C29,C34,A38", ",")
  ' Avec ce classeur
  With ThisWorkbook
    ' Boucler sur chque cellules
    For Ind = 0 To UBound(TabRngSce)
      ' Inscrire les valeur
      .Worksheets("Document").Range(TabRngDes(Ind)).Value = .Worksheets("Création").Range(TabRngSce(Ind)).Value
    Next Ind
    '...

• Xl60PassionFr

A+

 

[Phil69970]

Bonjour à tous

@JFR
Je te propose ce code

Sub Archivage()
Application.ScreenUpdating = False
Dim WsSrc As Worksheet, WsDest As Worksheet
Dim i&, ArSrc As Variant, ArDest As Variant

Set WsSrc = Worksheets("Création")
Set WsDest = Worksheets("Document")

ArSrc = Array("A2", "A6", "C6", "E6", "G6", "A9", "C9", "A13")
ArDest = Array("C17", "C14", "A23", "E23", "G23", "C29", "A38", "A34")

For i = LBound(ArSrc) To UBound(ArSrc)
    WsDest.Range(ArDest(i)).Value = WsSrc.Range(ArSrc(i)).Value ' La copie
    WsSrc.Range(ArSrc(i)).MergeArea.ClearContents               ' Le nettoyage
Next i
End Sub

Merci de ton retour