Optimisation numérique

Bonjour,

Je souhaiterais optimiser mon travail car je bidouille en VBA.

Dans mon fichier je remplis le masque et en cliquant sur le bouton cela vient complète mon tableau.

Je souhaiterais que mon numéro d’ordre continue de s’incrémenter à chaque clique mais aussi que l’année évolue en fonction de l’année en cour tout en redémarrant à 0001 .

Exemple :

- Au 31/12/2021 DHS-2021-XX/0574 clique => DHS-2021-XX/0575

- Au 01/01/2022 DHS-2021-XX/0575 =>DHS-2022-XX/0001

PS :voici le code actuel pour le bouton ma messagerie bloque le VBA

Private Sub CommandButton1_Click()

Dim g As Integer

'remplissage RECAP

g = Feuil3.Range("A" & Rows.Count).End(xlUp).Row

Feuil3.Range("A" & g + 1).Value = Feuil1.Range("D2")

Feuil3.Range("B" & g + 1).Value = Feuil1.Range("D4")

Feuil3.Range("C" & g + 1).Value = Feuil1.Range("D6")

Feuil3.Range("D" & g + 1).Value = Feuil1.Range("D8")

Feuil3.Range("E" & g + 1).Value = Feuil1.Range("D10")

'Vidange masque

Feuil1.Range("D4") = ""

Feuil1.Range("D6") = ""

Feuil1.Range("D8") = ""

Feuil1.Range("D10") = ""

Feuil1.Range("D4").Select

End Sub

Bonjour Yoichy

Voici le code qui prend en compte l'année

Private Sub Enregistrer()
  Dim nLig As Long
  Dim ShtM As Worksheet
  Dim NumOrdre As String
  Dim OldNum As Integer
  ' Définir la feuille masque
  Set ShtM = ThisWorkbook.Sheets("masque")
  'remplissage RECAP
  With ThisWorkbook.Sheets("RECAP")
    nLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & nLig).Value = ShtM.Range("D2")
    .Range("B" & nLig).Value = ShtM.Range("D4")
    .Range("C" & nLig).Value = ShtM.Range("D6")
    .Range("D" & nLig).Value = ShtM.Range("D8")
    .Range("E" & nLig).Value = ShtM.Range("D10")
  End With
  ' Vidange masque
  ShtM.Range("D4,D6,D8,D10").Value = ""
  ShtM.Range("D4").Select
  ' Incrémenter le numéro
  NumOrdre = "DHS-" & Year(Date) & "-XX/"
  OldNum = Application.WorksheetFunction.CountIf(Sheets("RECAP").Range("A:A"), NumOrdre & "*")
  NumOrdre = NumOrdre & Format(OldNum + 1, "0000")
  ShtM.Range("D2").Value = NumOrdre
  ' Effacer les variables objet
  Set ShtM = Nothing
End Sub

Et le fichier

@+

Merci cela fonctionne parfaitement