Microsoft 365 Nettoyage etape macro

[oceanepla]

Bonjour à tous,

Voici mon fichier, il y'a quelques étapes intermédiaires je pense qui pourraient être supprimées pour que ce soit plus fluide dans les macros. N'hésitez pas à me dire si vous avez des idées.

Merci pour votre aide,

 

[soan]

Bonsoir Océane,

ton fichier en retour ; sur la feuille "Saisie", clique sur "Valider" ;
patiente un moment, puis regarde toutes tes feuilles "PA...".

code VBA de Module1 :

Option Explicit

Dim sh As Worksheet

Private Sub Job(FX$)
  Dim k As Byte: Worksheets(FX).Select
  Rows(10).Insert Shift:=xlDown: k = 13 - (FX = "PA Général")
  [A11].Resize(, k).Copy: [A10].PasteSpecial -4122: k = k - 1
  With [A10]
    .Value = sh.[C22]        'Date de création de l'action
    .Offset(, 1) = sh.[C6]   'Origine de l'action
    .Offset(, 2) = sh.[C8]   'Sujet
    .Offset(, 3) = sh.[C20]  'Codification de l'action
    .Offset(, 4) = sh.[C4]   'Initiateur de l'action
    .Offset(, 5) = sh.[C10]  'Action à réaliser
    .Offset(, 6) = sh.[C12]  'Priorité
    .Offset(, 8) = sh.[C18]  'Date prévisionnelle de réalisation
    .Offset(, k) = sh.[C24]  'Commentaires
    .Select: .EntireRow.AutoFit
  End With
End Sub

Sub Macro1()
  If ActiveSheet.Name <> "Saisie" Then Exit Sub
 
  If Application.CountA(Sheets("Saisie").[C4,C6,C8,C10,C14]) < 5 _
    Then MsgBox "Les cellules Initiateur de l'action, Origine de l'action, Sujet, " _
       & "Action à réaliser, Département concerné doivent être remplies.": Exit Sub
 
  Dim N&, chn$: chn = Left$([C14], 3)
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
 
  If chn <> "DIT" Then Exit Sub 'sortie si département autre que "DIT" et "DITS"
 
  If [C22] <> "" Then 'on génère un code que si une date et un dpt sont présent ; mais inutile de
                      'tester de nouveau C14 : si on est ici, c'est que dpt = "DIT" ou "DITS"
    'Nombre de dpt dans PA Général +1
    N = Format(Application.CountIf(Worksheets("PA Général").[D:D], chn & "*") + 1, "00")
    [C20] = chn & Format([C22], "yymmdd") & N 'génération du code
  End If
  Set sh = Worksheets("Saisie"): Job "PA Général": Job "PA DSC": Job "PA DESG"
  Job "PA DAL": Job "PA DEP": Job "PA DIMS": sh.Select: Set sh = Nothing
  Application.Calculation = -4105: Application.EnableEvents = -1
  [C4:C20, C24].ClearContents
End Sub

Sub GénérerCode()
  If [C14] = "" Or [C22] = "" Then Exit Sub 'on génère un code que si une date et un dpt sont présent
  Dim N& 'Nombre de dpt dans PA Général +1
  N = Format(Application.CountIf(Worksheets("PA Général").[H:H], Right$([C14], 3) & "*") + 1, "00")
  [C20] = Right$([C14], 3) & Format([C22], "yymmdd") & N 'Génération du code
End Sub

à te lire pour avoir ton avis.

soan