XL 2013 Simplification de macros VBA

[sr94]

Bonjour,

Dans un classeur j’ai les feuilles suivantes :
- Une feuille de données « Production_Schedule »
- Une feuille « Cdes à rajouter » qui est une extraction d’access (extraite d’un ERP) qui affiche les lignes à rajouter dans la 1ère feuille (lignes absentes)
- Une feuille « Cdes à supprimer » qui est une extraction d’access qui affiche les lignes à supprimer de la 1ère feuille (lignes qui affichent 45 dans la colonne statut)
- Une feuille « COMPARAISON M3 » qui est une extraction d’access qui affiche les quantités à modifier dans la première feuille
(Les 3 dernières feuilles sont masquées)

Grace à des macros trouvées sur le net et à votre aide sur le forum j’ai pu « reconstituer » une macro pour supprimer les lignes / ajouter les lignes / modifier les quantités.

Je me demande maintenant si on ne peut pas simplifier ce code
Je ne peux pas joindre de fichier, le fichier de travail est lourd, il y a beaucoup de macros, de liaisons access etc … .

Voici les macros qui sont lancées à la suite :

Sub Supprimer_Lignes_Statut_45()

'Actualisation de la feuille "Cdes à supprimer"
With Sheets("Cdes à supprimer")
.Range("Tableau_Base_de_données2.accdb3[[#Headers],[NomFrs]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
End With
Sheets("Production_Schedule").Activate

'Supprimer les totaux de "Production Schedule"
ActiveSheet.ListObjects("Tableau2").ShowTotals = False

'Formule de RECHERCHEV pour le Statut 45
Range("AH5").FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP([@N°],'Cdes à supprimer'!C5:C8,4,FALSE)),"""",VLOOKUP([@N°],'Cdes à supprimer'!C5:C8,4,FALSE))"
        
'Supprimer les filtres
Range("A5").AutoFilter

'Supprimer les lignes en Statut 45
On Error Resume Next
For i = [AH65000].End(xlUp).Row To 2 Step -1
    If Cells(i, 34) <> "" Then Rows(i).Delete
Next i

'Remettre les filtres
Range("A5").AutoFilter

'Effacer la formule de RECHERCHEV pour le Statut 45
Range("AH5", Range("AH65536").End(xlUp)).ClearContents

'Ajouter les totaux
ActiveSheet.ListObjects("Tableau2").ShowTotals = True

'Actualisation de la feuille "Cdes à supprimer"
With Sheets("Cdes à supprimer")
.Range("Tableau_Base_de_données2.accdb3[[#Headers],[NomFrs]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
End With
Sheets("Production_Schedule").Activate

End Sub

Sub Ajouter_lignes()

'Actualiser "Cdes à rajouter"
With Sheets("Cdes à rajouter")
.Range("Tableau_Base_de_données2.accdb8[[#Headers],[StyleNom]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
End With
Sheets("Production_Schedule").Activate

'Supprimer les totaux de "Production Schedule"
ActiveSheet.ListObjects("Tableau2").ShowTotals = False

'Ajout des Lignes

Dim wb1 As Workbook
Application.ScreenUpdating = False

Set wb1 = Workbooks("Suivi des dates manuel.xlsm") 'Classeur source

On Error Resume Next
wb1.Sheets("Cdes à rajouter").Range("A2:J37" & [C65000].End(xlUp).Row - 1).SpecialCells(xlCellTypeConstants, 23).Copy _
wb1.Sheets("Production_Schedule").Range("E65536").End(xlUp)(2)

Application.ScreenUpdating = True

'Actualiser "Cdes à rajouter"
With Sheets("Cdes à rajouter")
.Range("Tableau_Base_de_données2.accdb8[[#Headers],[StyleNom]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
End With
Sheets("Production_Schedule").Activate

'Ajouter les totaux
ActiveSheet.ListObjects("Tableau2").ShowTotals = True

End Sub


Sub Comparaison()

'Actualiser "COMPARAISON M3"
With Sheets("COMPARAISON M3")
.Range("Tableau_Production_schedule_access.accdb[[#Headers],[NumLigne]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
End With

'Actualiser les quantités
F$ = """," & Feuil1.UsedRange.Columns(2).Address & ",0)"
Application.ScreenUpdating = False
With Feuil9.UsedRange.Rows
For R& = 2 To .Count
V = Feuil1.Evaluate("MATCH(""" & .Cells(R, 1).Text & F)
If IsNumeric(V) Then Feuil1.Cells(V, 12).Value = .Cells(R, 11).Value
Next
End With
Application.ScreenUpdating = True
End Sub

Merci.