VBA : simplifier macro

Sub efface()

'Macro qui efface les données de la matrice

'En cas d'erreur d'exécution, la macro doit se poursuivre
On Error Resume Next

'Fige l'écran
Application.ScreenUpdating = False

'Efface Formulaire et décolore les pictogrammes
Sheets("Formulaire").Select
ActiveSheet.Shapes.Range(Array("Picture 5", "Picture 2", "Picture 3", _
        "Picture 31", "Picture 7")).Select
Selection.ShapeRange.Glow.Radius = 0

'Barre de progression
Dim i As Long
For i = 0 To 3
    BarreDeSuppression.BarreVal i, 20
    
Next

Range("A2,B3,B5,B19").Select
Selection.ClearContents
Range("B28:F28").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("N6,N7").Select
Selection.ClearContents

'Barre de progression
For i = 4 To 6
    BarreDeSuppression.BarreVal i, 20

Next

'Efface Formulaire 2
Sheets("Formulaire (2)").Activate
Range("A9,A33,A49").Select
Selection.ClearContents
Range("A25:A27").Select
Selection.ClearContents

'Barre de progression
For i = 7 To 10
    BarreDeSuppression.BarreVal i, 20

Next

'Efface Compilemail Valeurs
Sheets("Compilemail Valeurs").Activate
Range("A2:C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'Barre de progression
For i = 11 To 14
    BarreDeSuppression.BarreVal i, 20
    
Next
    
'Efface la synthèse des contacts
Sheets("Synthèse des contacts").Activate
Range("A9:F9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents


'Barre de progression
For i = 15 To 18
    BarreDeSuppression.BarreVal i, 20
    
Next

'Rends invisible le bouton macro RestitutionContacts
Sheets("Formulaire").Activate
ActiveSheets.Shapes.Range(Array("Rectangle 24")).Select
Selection.ShapeRange.ZOrder msoBringToFront

'Barre de progression
For i = 19 To 20
    BarreDeSuppression.BarreVal i, 20
    
Next

'Enlèvre la barre de progression
Unload BarreDeSuppression

'Défige l'écran
Application.ScreenUpdating = True
Range("B3").Select

End Sub