Amélioration du code VBA

[Grimoolivier]

Bonjour à tous,

J’ai créé deux code VBA qui fonctionne très bien mais je pense que ça pourrait être beaucoup mieux codé. Avez-vous des idées pour améliorer les deux codes? D’avance je remercie les courageux.

Le premier code:

    Sub ajoutsuivi()

    ActiveSheet.Unprotect Password:="1234"
    ActiveWorkbook.Worksheets("Suivi annuel").ListObjects("PlanificateurÉvénements" _
        ).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Suivi annuel").ListObjects("PlanificateurÉvénements" _
        ).Sort.SortFields.Add Key:=Range("PlanificateurÉvénements[[#Headers],[Date]]" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Suivi annuel").ListObjects( _
        "PlanificateurÉvénements").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B4:J4").Select
    selection.ListObject.ListRows.Add (1)
    Range("J4") = Environ("username")
    Columns("B:B").Select
      selection.NumberFormat = "m/d/yyyy"
    Range("B4:H4").Select
    selection.Locked = False
    selection.FormulaHidden = False
    Range("B6:J30").Select
    selection.Locked = True
    selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("B4").Select
End Sub

Le deuxième code:

Sub enregistrer()
    Dim Chemin$, Nom$
    
    ActiveSheet.Unprotect Password:="1234"
        ActiveWorkbook.Worksheets("Suivi annuel").ListObjects("PlanificateurÉvénements" _
        ).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Suivi annuel").ListObjects("PlanificateurÉvénements" _
        ).Sort.SortFields.Add Key:=Range("PlanificateurÉvénements[[#All],[Date]]"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Suivi annuel").ListObjects( _
        "PlanificateurÉvénements").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
    Sheets("Rapports").Select
    ActiveSheet.Unprotect Password:="1234"
    ActiveSheet.PivotTables("Tableau croisé dynamique9").PivotCache.Refresh
    ActiveSheet.Shapes.Range(Array("Date")).Select
    ActiveWorkbook.SlicerCaches("ChronologieNative_Date").PivotTables(1).PivotCache _
        .Refresh
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowUsingPivotTables:=True
    Sheets("Suivi annuel").Select

 
Application.ScreenUpdating = False
 
Chemin = "C:\Users\Olivier\Desktop\Projet formation\archive\" 
Nom = "Archive_suivi_" & Range("D1")
 
Sheets("Suivi annuel").Range("B3:J2000").Copy 
Application.Workbooks.Add xlWBATWorksheet
With ActiveSheet
selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
.Name = Nom
.Range("A1").Select
End With
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs Chemin & Nom & ".xls"
.Close
End With
 
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ThisWorkbook.Save
Application.Visible = True
    
    Range("B4").Select
    MsgBox "Enregistrement effectué"


End Sub