XL 2013 Rendre une macro plus simple

ksimat

XLDnaute Junior
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

XLDnaute Barbatruc
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 :
Code:
  For numéroDeMois = 1 To 12
    Set feuilleDuClasseur = Nothing
    On Error Resume Next
    Set feuilleDuClasseur = Worksheets(Format(29 * numéroDeMois, "mmmm"))
eric
 

Noel Bedard

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Bonjour le fil, le forum

Pour l'effacement, il a fait petite une erreur :
VB:
'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)
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
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
VB:
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

XLDnaute Junior
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

XLDnaute Barbatruc
Re

@kismat
Autant pour moi, il me restait une once de fainéantise de dimanche soir ;)
VB:
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?
 

Staple1600

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Re

Allez une dernière avant le dodo
J'ai bien fait attention, j'ai bien tester ;)
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 925
Membres
101 841
dernier inscrit
ferid87