XL 2013 Rendre une macro plus simple

ksimat

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
 
Trier par date Trier par votes
N

Noel Bedard

XLDnaute Occasionnel
Bonjour,

Peut-être quelque chose du genre.
Code: 
Sub MiseAJourRegistre()
Dim ws As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
   For Each ws In ActiveWorkbook.Sheets
        ws.Select
       Range("A1").ClearContents
       Range("E5:BN104").ClearContents
       Range("E3").Select
       Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
   Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Attention cette routine choisira toutes les feuilles, incluant celle qui la lance.

Bien à vous.
Noël
 
Dernière édition:
Vote positif 0 Vote négatif
Patrice33740

Patrice33740

XLDnaute Impliqué
Ou bien :
Code: 
Option Explicit
Sub MiseAJourRegistre()
Dim feuilleDuClasseur As Worksheet
Dim numéroDeMois As Byte
Dim nomDuMois As String
  Application.ScreenUpdating = False
  For numéroDeMois = 1 To 12
    nomDuMois = Format(DateSerial(1900, numéroDeMois, 1), "mmmm")
    For Each feuilleDuClasseur In Worksheets
      With feuilleDuClasseur
        If LCase(feuilleDuClasseur.Name) = nomDuMois Then
          .Range("A1").ClearContents
          .Range("E5:BN104").ClearContents
          .Range("E3").AutoFill Destination:=.Range("E3:BN3"), Type:=xlFillDefault
        End If
      End With
   Next feuilleDuClasseur
  Next numéroDeMois
End Sub
 
Vote positif 0 Vote négatif
ksimat

ksimat

XLDnaute Junior
Bonsoir Noel Bedard,
Merci pour la proposition. Vous dites "Attention cette routine choisira toutes les feuilles, incluant celle qui la lance" alors que je veux que la macro intervienne uniquement sur les feuilles suivantes:
("octobre", "novembre", décembre", "janvier", "février", "mars", "avril", "mai", "juin", "juillet")
Jai déjà essayé ceci:
Dim Sh As Worksheet
For Each Sh In Sheets(Array("Octobre", "Novembre", "Décembre", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet"))
Sh.Range("A1").ClearContents
Sh.Range("E5:BN104").ClearContents
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault
Range("E3:BN3").Select
Next
Mais l'instruction (Selection.AutoFill Destination:=Range("E3:BN3"), Type:=xlFillDefault) n'est exécutée que sur une seule feuille.

Merci
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir

Ou bien encore ;)
VB: 
Sub a()
 Dim i&, Formule$
 Formule = "=ROW()*COLUMN()" 'ici mettre la vrai formule
 For i = 1 To 12
 On Error Resume Next
    With Sheets(Format(30 * i, "mmmm"))
    .Range("A1,E5:BN104") = "": .Range("E3:BN3").Formula = Formule
    End With
 Next
 End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
herve62

herve62

XLDnaute Barbatruc
Supporter XLD
Bonsoir
Attention le for each ws implique que l'on n'a pas un ou plusieurs onglets destinés à autre chose
Si j'ai Data en feuille1 , puis j'ai mes onglets Janvier fevrier etc.. les modif se feront aussi dans Data ce qui n'est peut être pas souhaité
Mieux vaut passer par for x= 2 to sheets.count ; si Data est onglet 1 de même si après les 12 mois reste des onglets avec des données on peut limiter avec sheets.count -1 ou -2 etc ...
En fait c'est pour délimiter un nombre d'onglets contigus parmi l'ensemble
Juste qu'ensuite il faut ajouter "worksheets(x).Range("A1").ClearContents" pour les instructions
ou encore on précise : "with sheets(x)" et là on met seulement ".range("A1").ClearContents"
chacun sa méthode
 
Vote positif 0 Vote négatif
ksimat

ksimat

XLDnaute Junior
Salut Patrice33740, Staple1600, hervé62, le forum,
Je confirme que le code de Patrice33740 fonctionne bien et n'impacte pas les autres feuilles. Je vais tester celui de hervé et vous rendrai compte, c'est le moins que je vous dois à vous tous. Merci à Staple1600 pour la proposition et à Hervé62 pour l'importante remarque.
A bientôt
 
Vote positif 0 Vote négatif
ksimat

ksimat

XLDnaute Junior
Re
Staple1600, pardon pour le retard. Je rencontre des problèmes avec votre code et cela doit être de ma faute. Je ne sais pas où mettre la formule dans le code. Si vous me proposez n'importe quel code je remplacerai ensuite.
Merci
PS: Le code efface la plage (A1:BN1) au lieu de la (A1) seulement.
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Bah il faudrait que je connaisse la formule qu'il a en E3
Tu peux poster un fichier exemple qu'on fasse des tests, stp ?

Sinon à partir où il y a bien 12 feuilles mensuelles en avec le nom en minuscule, cela fonctionne aussi sans le On error
VB: 
Sub b()
Dim i&, Formule$
Formule = "=ROW()*COLUMN()" 'ici mettre la vrai formule
 For i = 1 To 12
    With Sheets(Format(30 * i, "mmmm"))
    .Range("A1", "E5:BN104") = "": .Range("E3:BN3").Formula = Formule
    End With
Next
End Sub
 
Vote positif 0 Vote négatif
Patrice33740

Patrice33740

XLDnaute Impliqué
Staple1600 à dit:
Re

Patrice33740
Certes, oui ;)
Mais comme je ne connais pas la vraie formule ni n'ai pu tester faute de fichier exemple
J'ai fait dans la facilité et la fainéantise ;)
Cliquez pour agrandir...
Comme je suis moins fainéant j'aurais écrit :
Code: 
Option Explicit
Sub MiseAJourRegistre()
Dim feuilleDuClasseur As Worksheet
Dim numéroDeMois As Byte
Dim nomDuMois As String
  Application.ScreenUpdating = False
  For numéroDeMois = 1 To 12
    On Error Resume Next
    Set feuilleDuClasseur = Worksheets(Format(29 * numéroDeMois, "mmmm"))
    On Error GoTo 0
    If Not feuilleDuClasseur Is Nothing Then
      With feuilleDuClasseur
        .Range("A1").ClearContents
        .Range("E5:BN104").ClearContents
        .Range("E3").AutoFill Destination:=.Range("E3:BN3"), Type:=xlFillDefault
      End With
    End If
  Next numéroDeMois
End Sub
Mais même là on s'affranchit de certaines erreurs, pour bien faire il faudrait ajouter un gestionnaire d'erreur
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
Z
  • Question
Microsoft 365 Ajouter une étiquette de confidentialité via macro
Réponses
4
Affichages
858
onobyone
O
L
  • Question
XL 2019 Optimiser un code VBA dans un grand jeu de données
Réponses
4
Affichages
585
Loïc DUBOIS
L
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
265
robpellan52
R
Chasse
  • Question
Microsoft 365 Copier et coller formes sans changer de feuille
Réponses
2
Affichages
402
Chasse
Chasse
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
831
Dranreb
Dranreb
B
  • Résolu(e)
XL 2016 macro avec boucle
2
Réponses
16
Affichages
1 K
benbella1991
B
A
  • Résolu(e)
XL 2016 Autofill Destination sur colonne adjacente
Réponses
3
Affichages
349
Aldonanou
A
pmfontaine
  • Question
Microsoft 365 Erreur d'exécution 5 argument ou appel de procédure incorrect avec ActiveSheet.ChartObjects.Add()
Réponses
12
Affichages
405
pmfontaine
pmfontaine

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 61 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 196
Messages
2 086 100
Membres
103 116
dernier inscrit
kutobi87