XL 2010 Accélérer un code VBA

[NICOALBERT]

Bonjour le forum ,

Je vient vers vous pour une petite question .

J'ai une macro qui va chercher des informations dans une feuille la mettre dans une autre et ceux plus d'une centaine de fois .

Est il possible d'alléger une macro en mettant certaine fonction en OFF ?

Tel que la vision des feuilles , le recalcul systématique Etc ....

Cdlt Nicoalbert .

 

[phlaurent55]

Bonjour nicoAlbert,

sans voir le fichier je peux déjà te suggérer ceci:

en début de code,
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

et en fin de code,
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

à+
Philippe

 

[NICOALBERT]

Bonjour phlaurent55 ,

Merci pour ta réponse , je l'ai déjà testé et ça me bloque mes calcul également

 

[Dranreb]

Bonjour.
Il n'y a qu'une seule solution royale garantissant le rapidité, c'est de ne jamais utiliser Cells, Range ni Evaluate …
… Sauf une seule fois au début et une seule fois à la fin, le reste du traitement ne travaillant qu'avec des tableau VBA dynamiques.

 

[NICOALBERT]

Voici le Code que j'utilise . ( Je débute en VBA donc mon code doit être très sale pour des experts)

Sub Lancement()

Sheets("Programme").Select

Application.Run "PlacementNomEquipe"
Application.Run "MiseEnPagePerformance"
Application.Run "Saison"
Application.Run "FormuleEtudeQT"
Application.Run "PlacementJoueursEQ1"
Application.Run "PlacementJoueursEQ2"
Application.Run "RefEquipe1"
Application.Run "RefEquipe2"
Application.Run "RefEquipe3"
Application.Run "RefEquipe4"

End Sub
-------------------------------------------------------------------------------------
Sub PlacementNomEquipe() ' Sert à placer le nom des équipe dans chaque feuille

Sheets("Programme").Select
Range("B1").Select
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
Range("I1").Select
ActiveSheet.Paste
Range("B11").Select
ActiveSheet.Paste

Sheets("Synthese").Select
Range("J2:X2").Select
ActiveSheet.Paste

Sheets("Formule").Select
Range("D1:K1").Select
ActiveSheet.Paste
Range("B22:K22").Select
ActiveSheet.Paste
Range("L23:N23").Select
ActiveSheet.Paste
Range("B30:I30").Select
ActiveSheet.Paste
Range("B70:O70").Select
ActiveSheet.Paste
Range("B81:J81").Select
ActiveSheet.Paste
Range("B93:G93").Select
ActiveSheet.Paste

Sheets("Recherche suivant EQ AdverseEQ1").Select
Range("D1:J1").Select
ActiveSheet.Paste
Range("V1:AB1").Select
ActiveSheet.Paste

Sheets("Recherche suivant EQ AdverseEQ2").Select
Range("D2:J2").Select
ActiveSheet.Paste

Sheets("Formule Joueurs").Select
Range("A3").Select
ActiveSheet.Paste

Sheets("Programme").Select
Range("B2").Select
Selection.Copy
Range("H1").Select
ActiveSheet.Paste
Range("K1").Select
ActiveSheet.Paste
Range("B7").Select
ActiveSheet.Paste

Sheets("Synthese").Select
Range("AH2:AV2").Select
ActiveSheet.Paste

Sheets("Formule").Select
Range("D11:K11").Select
ActiveSheet.Paste
Range("B24:K24").Select
ActiveSheet.Paste
Range("L24:N24").Select
ActiveSheet.Paste
Range("B36:I36").Select
ActiveSheet.Paste
Range("R70:AE70").Select
ActiveSheet.Paste
Range("R81:Z81").Select
ActiveSheet.Paste
Range("J93:O93").Select
ActiveSheet.Paste

Sheets("Recherche suivant EQ AdverseEQ2").Select
Range("D1:J1").Select
ActiveSheet.Paste
Range("V1:AB1").Select
ActiveSheet.Paste

Sheets("Recherche suivant EQ AdverseEQ1").Select
Range("D2:J2").Select
ActiveSheet.Paste

Sheets("Formule Joueurs").Select
Range("A4").Select
ActiveSheet.Paste

Sheets("Programme").Select
Range("B8").Select
Selection.Copy
Range("J1").Select
ActiveSheet.Paste

Sheets("Recherche suivant EQ AdverseEQ1").Select
Range("V2:AB2").Select
ActiveSheet.Paste

Sheets("Programme").Select
Range("B12").Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste

Sheets("Recherche suivant EQ AdverseEQ2").Select
Range("V2:AB2").Select
ActiveSheet.Paste

End Sub
-----------------------------------------------------------------------------
Sub RefEquipe1() 'Récupération des données ref_Equipe pour étude match suivant

With Sheets("Programme") 'Récup donnéees colonnes
.[G2].FormulaArray = "=HLOOKUP(R1C7,Réf_Equipe!R1C1:R1050C30,ROW(),FALSE)"
'=RECHERCHEH($A$1;Réf_Equipe!$A$1:$AD$1050;LIGNE();FAUX)
.[G2].Copy .[G3:G1050]
.[G2:G1050] = .[G2:G1050].Value
End With

Columns("G:G").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

' ----- Copie la référence de l'Equipe 1 en colonne I -----

Sheets("Programme").Select
Range("G2:G1100").Select
Selection.Copy

Sheets("Programme").Select
Range("I2:I1050").Select
ActiveSheet.Paste

End Sub
-----------------------------------------------------------------------------------
Sub RefEquipe2()

With Sheets("Programme") 'Récup donnéees colonnes
.[H2].FormulaArray = "=HLOOKUP(R1C8,Réf_Equipe!R1C1:R1050C30,ROW(),FALSE)" 'Formule Recherche de référence
'=RECHERCHEH($A$1;Réf_Equipe!$A$1:$AD$1000;LIGNE();FAUX)
.[H2].Copy .[H3:H1050]
.[H2:H1050] = .[H2:H1050].Value 'supprime les formules
End With

Columns("H:H").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

' ----- Copie la référence de l'Equipe 2 en colonne K -----

Sheets("Programme").Select
Range("H2:H1100").Select
Selection.Copy

Sheets("Programme").Select
Range("K2:K1050").Select
ActiveSheet.Paste

End Sub
------------------------------------------------------------------------------------------------
Sub RefEquipe3()

With Sheets("Programme") 'Récup donnéees colonnes
.[J2].FormulaArray = "=HLOOKUP(R1C10,Réf_Equipe!R1C1:R1050C30,ROW(),FALSE)" 'Formule Recherche de référence
'=RECHERCHEH($A$1;Réf_Equipe!$A$1:$AD$1000;LIGNE();FAUX)
.[J2].Copy .[J3:J1050]
.[J2:J1050] = .[J2:J1050].Value 'supprime les formules
End With

Columns("J:J").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

End Sub
--------------------------------------------------------------------------------------------------------
Sub RefEquipe4()

With Sheets("Programme") 'Récup donnéees colonnes
.[L2].FormulaArray = "=HLOOKUP(R1C12,Réf_Equipe!R1C1:R1050C30,ROW(),FALSE)" 'Formule Recherche de référence
'=RECHERCHEH($A$1;Réf_Equipe!$A$1:$AD$1000;LIGNE();FAUX)
.[L2].Copy .[L3:L1050]
.[L2:L1050] = .[L2:L1050].Value 'supprime les formules
End With

Columns("L:L").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False

End Sub
-------------------------------------------------------------------------------------
Sub PlacementJoueursEQ1() ' Copie les joueurs de la feuille Programme vers JoueursEQ1

Sheets("Programme").Select
Range("B17:B37").Select
Selection.Copy
Sheets("JoueursEQ1").Select
Range("A1").Select
ActiveSheet.Paste

End Sub
------------------------------------------------------------------------------------------------
Sub PlacementJoueursEQ2()

Sheets("Programme").Select
Range("C17:C37").Select
Selection.Copy
Sheets("JoueursEQ2").Select
Range("A1").Select
ActiveSheet.Paste

End Sub

 

[phlaurent55]

Re,

Ne possédant pas de camion-balai pour effectuer tout le nettoyage nécessaire, je le fait manuellement sur cette dernière procédure :

Sub PlacementJoueursEQ2()

Sheets("Programme").Select
Range("C17:C37").Select
Selection.Copy
Sheets("JoueursEQ2").Select
Range("A1").Select
ActiveSheet.Paste

End Sub

qui peut être remplacée par ce code beaucoup plus court qui fait la même chose tout en évitant le "Select"

Sub PlacementJoueursEQ2()
Sheets("Programme").Range("C17:C37").Copy Destination:=Sheets("JoueursEQ2").Range("A1")
End Sub

....... bon courage pour tout le reste

à+
Philippe

 

[NICOALBERT]

Un grand merci je vais voir pour modifier mon code avec tes instructions.

@+ Nicolas