simplifier une macro faite avec l'éditeur de macro

pascal21

pascal21

XLDnaute Barbatruc
Code: 
Sub effacer_données()


Dim reponse
reponse = MsgBox("Vous allez supprimer des données" & vbNewLine & "et sauvegarder dans les feuilles recap " & vbNewLine & "" & vbNewLine & "           VOUS CONFIRMEZ?", vbYesNo + vbExclamation, "Suppression")
If reponse = vbYes Then
 'affiche les feuilles recap masquées
   Sheets(11).Visible = True
      Sheets(12).Visible = True
      Sheets(13).Visible = True
      Sheets(14).Visible = True
      Sheets(15).Visible = True
      Sheets(16).Visible = True
      Sheets(17).Visible = True
      Sheets(18).Visible = True
      Sheets(19).Visible = True
      Sheets(20).Visible = True
 Sheets(1).Select
 'copie les données dans les feuilles recap
    Range("a4:U38").Select
    Selection.Copy
   Sheets(11).Select
   Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    
    Sheets(2).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets(12).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    Sheets(3).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets(13).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(4).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(14).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(5).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(15).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   Sheets(6).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(16).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Sheets(7).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(17).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(8).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets(18).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
   Sheets(9).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(19).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Sheets(10).Select
    Range("a4:U38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(20).Select
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'masque les feuilles recap
      Sheets(11).Visible = False
      Sheets(12).Visible = False
      Sheets(13).Visible = False
      Sheets(14).Visible = False
      Sheets(15).Visible = False
      Sheets(16).Visible = False
      Sheets(17).Visible = False
      Sheets(18).Visible = False
      Sheets(19).Visible = False
      Sheets(20).Visible = False
   
    'efface les données
  Sheets(1).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(2).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(3).Select
    Range("C4:K38").Select
    Selection.ClearContents

    Sheets(4).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(5).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(6).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(7).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(8).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(9).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Sheets(10).Select
    Range("C4:K38").Select
    Selection.ClearContents
    
    Range("C4").Select
    Sheets(1).Select
Else
If reponse = vbNo Then
  Exit Sub
End If
End If
End Sub
bonjour à tous
grace à l'éditeur de macro et aussi avec je que j'ai pu trouver par ci par là et aussi grace à votre aide, j'ai cette macro longue comme un jour sans pain que j'aimerais simplifier
malheureusement c'est au dessus de mes connaissances
pouvez m'aider merci
il s'agit de copier coller la même plage de cellule dans les feuilles recap et ensuite d'effacer le contenu de cette plage
je fais en fait une sauvegarde chaque mois

feuil1 dans feuil11 feuil2 --->feul12 etc.... sur 10 feuilles
 
Dernière édition:
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re : simplifier une macro faite avec l'éditeur de macro

Salut Pascal21,

Voilà ton code légèrement raccourcis :D

Code: 
Sub effacer_données()
  Dim reponse
  reponse = MsgBox("Vous allez supprimer des données" & vbNewLine & "et sauvegarder dans les feuilles recap " & vbNewLine & "" & vbNewLine & "           VOUS CONFIRMEZ?", vbYesNo + vbExclamation, "Suppression")
  If reponse = vbYes Then
   'affiche les feuilles recap masquées
    For I = 11 To 20
     Sheets(I).Visible = True
    Next I
    ' Copie les données
    For I = 1 To 10
    Sheets(I).Range("a4:U38").Copy
    Sheets(10 + I).Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ' Masque les feuilles récap
    For I = 11 To 20
     Sheets(I).Visible = False
    Next I
    'efface les données
    For I = 1 To 10
      Sheets(I).Range("C4:K38").ClearContents
    Next I
    
    Sheets(1).Select
    Range("C4").Select
  ElseIf reponse = vbNo Then
    Exit Sub
  End If
End Sub

Pense à utliser les boucles For ... Next

Voilà ;)
 
Vote positif 0 Vote négatif
wilfried_42

wilfried_42

XLDnaute Barbatruc
Re : simplifier une macro faite avec l'éditeur de macro

bonjour pascal

sub effacer_donnee()
dim i as integer
if MsgBox("Vous allez supprimer des données" & vbNewLine & "et sauvegarder dans les feuilles recap " & vbNewLine & "" & vbNewLine & " VOUS CONFIRMEZ?", vbYesNo + vbExclamation, "Suppression")
<> vbYes Then exit sub
application.screenupdating = false
for i = 1 to 10
sheets(i+10).visible = true
sheets(i+10).select
sheets(i).range(A4:U38).copy
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
sheets(i).range("C4:K38").clearcontents
sheets(i+10).visible = false
next i
sheets(1).select : range("C4").select
application.screenupdating = true
end sub
Cliquez pour agrandir...

Excuse bruno, j'ai pas raffraichi, bonjour
 
Vote positif 0 Vote négatif
pascal21

pascal21

XLDnaute Barbatruc
Re : simplifier une macro faite avec l'éditeur de macro

re je n'ai pas pu resister, j'ai essayé
j'ai testé les 2 codes et j'ai une erreur "variable non définie" sur les deux
cette fois je vais au lit, y a la grande qui vient d'aller se coucher, faut que j'y aille aussi. lol!!!
 
Vote positif 0 Vote négatif
pascal21

pascal21

XLDnaute Barbatruc
Re : simplifier une macro faite avec l'éditeur de macro

bonjour
j'ai un message type boite de dialogue bien sur
lorsque je colle ta macro j'ai la ligne
Code: 
if MsgBox("Vous allez supprimer des données" & vbNewLine & "et sauvegarder dans les feuilles recap " & vbNewLine & "" & vbNewLine & " VOUS CONFIRMEZ?", vbYesNo + vbExclamation, "Suppression")
<> vbYes Then exit sub
se colore en rouge
 
Dernière édition:
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : simplifier une macro faite avec l'éditeur de macro

Bonjour Pascal, le fil

tu mets tout sur la même ligne, ou avec un "_" en fin de première ligne pour signaler que c'est la même instruction, comme ci dessous :

Code: 
If MsgBox("Vous allez supprimer des données" & vbNewLine & "et sauvegarder dans les feuilles recap " & vbNewLine & "" _
    & vbNewLine & " VOUS CONFIRMEZ?", vbYesNo + vbExclamation, "Suppression") <> vbYes Then Exit Sub

bonne soirée
@+
 
Vote positif 0 Vote négatif

Discussions similaires

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
272
robpellan52
R
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
124
Francky79
F
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
340
gwenn49
G
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
445
olivier388
O
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
P
  • Résolu(e)
XL 2010 Réduire la macro
Réponses
2
Affichages
294
Panda79360
P
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
314
Usine à gaz
Usine à gaz
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
214
Compte Supprimé 979
C
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
529
mouchtre
mouchtre
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
374
fanou06
F

Membres actuellement en ligne

13 membres et 304 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 239
Messages
2 086 508
Membres
103 237
dernier inscrit
smbt-excel