XL 2013 Rendre une macro plus simple

[ksimat]

Bonjour le forum,
Ma macro que j'ai réalisée par l'enregistreur de macro est trop longue et exécute les mêmes instructions sur plusieurs onglets. Je voudrais donc la rendre plus simple avec votre aide. Dans chaque feuille ("octobre", "novembre", "décembre" etc.) elle doit:
1 - Effacer le cellule (A1)
2 - Effacer la plage (E5:BN104)
3 - Appliquer la formule de la cellule (E3) sur la plage (E3:BN3)
Je précise que cette macro sera appelée dans une autre procédure liée elle à un bouton. En vous remerciant d'avance je colle ici la macro:

Sub MiseAJourRegistre()
Application.ScreenUpdating = False
Sheets("Octobre").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Novembre").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Décembre").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Janvier").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Février").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Mars").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Avril").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Mai").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Juin").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Sheets("Juillet").Select
Range("A1").ClearContents
Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
End Sub

 

[eriiic]

Bonjour,

j'ai testé par curiosité, pas de plantage non plus.
Seule petite anomalie si on veut, en cas d'erreur c'est la dernière feuille qui reste, et non nothing. Mai est donc fait plusieurs fois pour rien.
Si on veut l'éviter :

  For numéroDeMois = 1 To 12
    Set feuilleDuClasseur = Nothing
    On Error Resume Next
    Set feuilleDuClasseur = Worksheets(Format(29 * numéroDeMois, "mmmm"))

eric

 

[Noel Bedard]

Bonsoir à tous,

Ok , j'ai trouvé, dans l'éditeur VBA sous Outils - Options - Général - Récupération d'erreur.
J'ai déplacé la sélection de Arrêt sur toutes les erreurs à Arrêt sur les erreurs non gérées.

Maintenant plus d'erreur.

eriiiic: avec votre code je recevais le même avertissement.


Merci beaucoup
Noël

 

[Staple1600]

Bonjour le fil, le forum

Pour l'effacement, il a fait petite une erreur :

'au lieu de :
.Range("A1", "E5:BN104") = ""
'écrire
.Range("A1, E5:BN104") = ""

(comme quoi, parfois il vaut mieux écrire 2 lignes 🙂)

Que nenni!
J'ai pas fait une petite erreur 😉
J'ai fait deux erreurs
1) J'ai testé mon code avec On Error Resume Next
2) J'étais en mode : Sunday coding (ou gros fainéant en pyjama dans VBA )
Mais comme dit Yoda: "Le plus grand des Maîtres, l'échec être"
(ça marche aussi avec l'erreur)

 

[Staple1600]

Re

Je viens de me rappeler cette possibilité* rarement utilisée 😉
Pré-requis
On présuppose que le classeur contient déjà 12 feuilles mensuelles.
Dans la feuille Janvier, les formules sont déjà là.
Les 12 feuilles ont déjà les même largeurs de colonne et hauteurs de ligne sur les plages concernées.
Test OK sur le fichier joint par le demandeur.
(auquel j'ai ajouté, en copiant la feuille Janvier N fois pour avoir les 12 feuilles mensuelles)
La macro

Sub MiseAjourRegistre()
Dim arrWSN
arrWSN = Array("janvier", "février", "mars", "avril", "mai", "juin", "juillet", "août", "septembre", "octobre", "novembre", "décembre")
For i = 1 To 12
    With Sheets(Format(30 * i, "mmmm"))
    .[A1] = "": .[E5:BN104] = "": .[C1] = i: .[D1] = 2017
    End With
Next
'*: la possibilté en question: FillAcrossSheets 
Worksheets(arrWSN).FillAcrossSheets Worksheets("Janvier").Range("E1:BN3"), xlFillWithFormats
End Sub

 

[ksimat]

Bonjour à tous,
En ouvrant cette discussion j'étais loin de soupçonner qu'elle serait si riche et instructive pour moi, même si je sais qu'ICI une discussion n'est jamais close. Même si une réponse satisfaisante est donnée à un demandeur, cela n'empêche que d'autres solutions sont souvent proposées faisant le bonheur de tous ces anonymes qui viennent y trouver le sésame. Les débutants et les cancres n'y sont jamais rabroués, au contraire on leur demande de mieux reposer leur problème et s'il le faut de proposer un fichier exemple. Quelle pédagogie et quel altruisme! Personnellement j'ai plusieurs fois trouvé seul la solution en essayant de mieux vous poser mon problème. J'ai aussi souvent réglé mon problème en jouant les égoutiers dans les vieux posts des bas fonds de ce forums. Soyez-en tous remerciés.
Pour revenir à cette discussion, je Redis que mon classeur compte 10 mois en plus des autres feuilles non impactées par la macro de Patrice11740 qui marche bien.
Le test du dernier code de Staple1600 donne l'erreur "variable i non défini" .
Encore Merci à tous et bonne fin de soirée.
Ksimat

 

[Staple1600]

Re

@kismat
Autant pour moi, il me restait une once de fainéantise de dimanche soir 😉

Sub MiseAjourRegistre()
Dim arrWSN, i as Byte
arrWSN = Array("janvier", "février", "mars", "avril", "mai", "juin", "juillet", "août", "septembre", "octobre", "novembre", "décembre")
For i = 1 To 12
    With Sheets(Format(30 * i, "mmmm"))
    .[A1] = "": .[E5:BN104] = "": .[C1] = i: .[D1] = 2017
    End With
Next
'*: la possibilté en question: FillAcrossSheets 
Worksheets(arrWSN).FillAcrossSheets Worksheets("Janvier").Range("E1:BN3"), xlFillWithFormats
End Sub

Pourquoi tu n'as pas les 12 feuilles des 12 mois d'une année dans ton classeur?

 

[ksimat]

Re
@Staple1600, Avec un nombre de mois inférieur à 12 ça bug mais cette fois-ci à la ligne "With Sheets(Format(30 * i, "mmmm"))". Par contre c'est OK si j'ajoute les mois manquants.

Dans mon projet il y a deux mois qui ne seront pas concernés donc inutiles.
Merci

 

[Staple1600]

Re

j'avais bien précisé en préambule

Pré-requis
On présuppose que le classeur contient déjà 12 feuilles mensuelles.

Donc si il y a que 10 feuilles alors, il suffit de mettre que 10 noms de feuilles dans le tableau
arrWSN = Array("janvier", "février", "mars", "avril", "mai", "juin", "juillet", "août", "septembre", "octobre")
et de faire
For i=1 to 10

 

[Staple1600]

Re

Allez une dernière avant le dodo
J'ai bien fait attention, j'ai bien tester 😉

Sub a()
Dim arrWSN, i As Byte
arrWSN = Array("Octobre", "Novembre", "Décembre", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet")
For i = LBound(arrWSN) To UBound(arrWSN)
    With Sheets(arrWSN(i))
    .[A1] = "": .[E5:BN104] = "": .[C1] = Month("1-" & arrWSN(i)): .[D1] = 2017
    End With
Next
Worksheets(arrWSN).FillAcrossSheets Worksheets("Janvier").Range("E1:BN3")
End Sub

 

[eriiic]

@Noel Bedard

eriiiic: avec votre code je recevais le même avertissement.

Bien sûr.
Il n'est pas fait pour éviter une erreur inévitable et gérée, mais pour éviter de lancer des traitements inutiles (refaire une feuille déjà faite lorsque la suivante est absente).
eric

 

[Staple1600]

Bonsoir eriiiic

Et que penses-tu de mon FillAcrossSheets?
Histoire que j'aille m'endormir le teint frais et rasséréné par tes lumières? )

Bonne nuit à tous 😉

 

[ksimat]

Taple1600,
Un sommeil tranquille bien mérité te revient. Cela marche sur mes dix mois prévus. Mieux ton FillAcrossSheets m'a bluffé quand j'ai ajouté un mois sans vide.
Bon dodo et merci
Ksimat