Sujet Précédent Sujet Suivant

COMMENT REDUIRE LA TAILLE DE MA MACRO?

Résolu
simonbaron Messages postés 9 Date d'inscription lundi 23 mai 2011 Statut Membre Dernière intervention 23 janvier 2013 - 10 juin 2011 à 21:03
pile_poil Messages postés 682 Date d'inscription vendredi 6 avril 2007 Statut Membre Dernière intervention 4 août 2012 - 11 juin 2011 à 11:32
Bonjour,

J'ai crée une macro pour récuperer des données à partir de plusieurs onglets dans un fichier et les coller dans un tableau (onglet "REGISTRE") qui se trouve dans le meme ficheir. J'ai ajouté des messages d'erreur si les cellules qui m'interessent ne sont pas completées. Mon fichier fait 9Mega, je devrais essayer de réduire sa taille, mais je n'ai aucune idée de comment modifier ma macro. Quelqu'un pourrait m'aider SVP? Merci beaucoup, je copie le texte de ma macro, il est un peu long mais le principe est assez simple: on ouvre l'onglet avec le tableau, on selectionne la première cellule vide d'une ligne, on ouvre le premier onglet avec les données à récupérer, on vérifie si cetaines cellules ont été remplies, on copie les données, on les colle dans le tableau et on passe à la ligne suivante. On repète ça pour tous les onglets. Merci beaucoup!

Sub VALIDATIONFINALE()

Sheets("REGISTRE").Select
Range("IV3").End(xlToLeft).Offset(0, 1).Select
Sheets("Customers complaints").Select

If Range("D13").Value "" Or Range("B16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!": Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Customers complaints").Select
Range("B16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Customers complaints").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV4").End(xlToLeft).Offset(0, 1).Select
Sheets("Unavailability sub. services").Select

If Range("D13").Value "" Or Range("B16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-1, 0).Range("A1:C1").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Unavailability sub. services").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Unavailability sub. services").Select
Range("B16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Unavailability sub. services").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



Range("IV5").End(xlToLeft).Offset(0, 1).Select
Sheets("Unavailability major applic.").Select

If Range("D13").Value "" Or Range("D16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-2, 0).Range("A1:C2").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Unavailability major applic.").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Unavailability major applic.").Select
Range("D16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Unavailability major applic.").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV6").End(xlToLeft).Offset(0, 1).Select
Sheets("Turn over").Select

If Range("D13").Value "" Or Range("D16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-3, 0).Range("A1:C3").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Turn over").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Turn over").Select
Range("D16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Turn over").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV7").End(xlToLeft).Offset(0, 1).Select
Sheets("Absence").Select

If Range("D13").Value "" Or Range("B16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-4, 0).Range("A1:C4").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Absence").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Absence").Select
Range("B16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Absence").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV8").End(xlToLeft).Offset(0, 1).Select
Sheets("Rate of absenteeism").Select

If Range("D13").Value "" Or Range("D16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-5, 0).Range("A1:C5").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Rate of absenteeism").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Rate of absenteeism").Select
Range("D16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Rate of absenteeism").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV9").End(xlToLeft).Offset(0, 1).Select
Sheets("Respect time limit fin. cert.").Select

If Range("B16").Value "" Or Range("B18").Value "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-6, 0).Range("A1:C6").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Respect time limit fin. cert.").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Respect time limit fin. cert.").Select
Range("D16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Respect time limit fin. cert.").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV10").End(xlToLeft).Offset(0, 1).Select
Sheets("Statutory audit report with res").Select

If Range("D13").Value "" Or Range("B16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-7, 0).Range("A1:C7").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Statutory audit report with res").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Statutory audit report with res").Select
Range("B16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Statutory audit report with res").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV11").End(xlToLeft).Offset(0, 1).Select
Sheets("Major recomm. not put in place").Select

If Range("D13").Value "" Or Range("B16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-8, 0).Range("A1:C8").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Major recomm. not put in place").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Major recomm. not put in place").Select
Range("B16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Major recomm. not put in place").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV12").End(xlToLeft).Offset(0, 1).Select
Sheets("Failure vital-critical staff").Select

If Range("D13").Value "" Or Range("B16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-9, 0).Range("A1:C9").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Failure vital-critical staff").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Failure vital-critical staff").Select
Range("B16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Failure vital-critical staff").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("IV13").End(xlToLeft).Offset(0, 1).Select
Sheets("Systems interruption").Select

If Range("D13").Value "" Or Range("B16").Value "" Or Range("B18").Value = "" Then
MsgBox " SOME DATA IS MISSING!!!"
Sheets("REGISTRE").Select
ActiveCell.Offset(-10, 0).Range("A1:C10").Select
ActiveCell.Activate
Selection.ClearContents
Sheets("Systems interruption").Select: Exit Sub
End If

Range("D13:G13").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Systems interruption").Select
Range("B16:G16").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

Sheets("Systems interruption").Select
Range("B18:G18").Select
Selection.Copy
Sheets("REGISTRE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select


MsgBox " THANKS!"



End Sub

1 réponse

Réponse 1 / 1
pile_poil Messages postés 682 Date d'inscription vendredi 6 avril 2007 Statut Membre Dernière intervention 4 août 2012 6
11 juin 2011 à 11:32
bonjour
tu as écrit : 
Sheets("Systems interruption").Select
Range("B18:G18").Select
Selection.Copy

tu pourrais rendre ça plus digeste en faisant: 
Sheets("Systems interruption").Range("B18:G18").Copy

cette surabondance de .Select est nauséeuse de plus elle ralentit l'exécution du code puisqu'elle implique des ré-affichages perpétuels de pages

applique cette clarification du code systématiquement et tu devrais t'en trouver bien


si c'est la solution, penser : REPONSE ACCEPTEE
3

Discussions similaires

[D7] Impression code-barres sur une imprimante d'étiquettes
cs_nitrique -
cs_nitrique -

15 réponses
recuperer la taille d'un tableau avec php, c'est possible??
cs_redemption -
JaMyGG -

8 réponses
Récupérer par une macro les dimension d'une pièce sur CATIA
fehmous -
fehmous -

4 réponses
Condition d'une valeur dans un tableau
solomonn -
solomonn -

17 réponses
Activer macros outlook
biggir -
ajarnaud -

4 réponses
Rejoignez-nous