Optimisation pour une mise en page

[Michounours]

Bonjour les pros,
étant débutant j'ai quand même réussi à me faire une macro permettant de faire une mise en page automatique (en tête et pied de page) pour tous mes onglets de mon fichier (en se servant de données dans les cellules de ma première page).
Le problème est que ça met à peut prés 3 secondes par onglet.
(Il se peut qu'il y ai 30 onglet 😱 )

Voici mon code :

Sub RIM()

Dim nbfeuille As Integer 'Création des variables
Dim X As Integer
Dim indice, d, nom, codearticle As String

X = 1 'Variable contenant le numéro de la page sélectionnée
nom = Sheets("RIM").Range("G12") 'Variable contenant le nom de la carte
codearticle = Sheets("RIM").Range("G15") 'Variable contenant le code article de la carte

For j = 23 To 37 'Détecte l'indice
d = Sheets("RIM").Range("A" & j)
If d <> "" Then indice = d
Next

nbfeuille = ThisWorkbook.Worksheets.Count 'Variable contenant le nombre de page dans le classeur

For i = 1 To nbfeuille 'Sélectionne les pages auxquelles on applique les lignes suivantes

ThisWorkbook.Worksheets(i).Activate 'Ecrit l'entête et pied de pages dans les pages sélectionnée au dessus
With ActiveSheet.PageSetup
.LeftFooter = "édition du 17/03/2009"
.RightFooter = "Page " & X & " / " & nbfeuille
End With
If i <> 1 Then
With ActiveSheet.PageSetup
.LeftHeader = "&""Arial,Gras""&12CARTE" & nom
.CenterHeader = "&""Arial,Gras""&12" & codearticle
.RightHeader = "&""Arial,Gras""&12INDICE" & " " & indice
End With

End If

X = X + 1 'Va à la page suivant

Next

End Sub

Si quelqu'un a une solution, je suis preneur !
Merci d'avance.