Optimisation et simplification de cette macro

bonjour,

mets-toi en mode calcul manuel et supprime tous les select. je t'ai préparé les instructions pour soc 1 et soc2, il te reste soc3.

cela devrait aller beaucoup plus vite

Sub Partie1()

''''''''''''''''''
'''Optimisation'''
''''''''''''''''''

timerdebut = Timer
Application.ScreenUpdating = False
savcal = Application.Calculation
Application.Calculation = xlCalculationManual
''''''''''
'''SOC1'''
''''''''''

' Entite Macro

    Range("B2").FormulaR1C1 = _
        "=SUBSTITUTE('[SOC1.XLSX]AR Outstanding Summary In Local'!R1C2,'[SOC1.XLSX]AR Outstanding Summary In Local'!R1C2,""SOC1"")"
    Range("B2").AutoFill Destination:=Range("B2:B2000")

' Code Macro

    Range("C2").FormulaR1C1 = _
        "='[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C3"
    Range("C2").AutoFill Destination:=Range("C2:C2000")
    Columns("C:C").EntireColumn.AutoFit

' RaisonSociale Macro

    Range("D2").FormulaR1C1 = _
        "='[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C4"
    Range("D2").AutoFill Destination:=Range("D2:D2000")

' NonEchu Macro

    Range("G2").FormulaR1C1 = _
        "=SUM('[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C19:R[20]C22)"
    Range("G2").AutoFill Destination:=Range("G2:G2000")

' TotEchu Macro

    Range("H2").FormulaR1C1 = _
        "=SUM('[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C24:R[20]C27)"
    Range("H2").AutoFill Destination:=Range("H2:H2000")

' Echu130 Macro

    Range("I2").FormulaR1C1 = _
        "='[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C24"
    Range("I2").AutoFill Destination:=Range("I2:I2000")

' Echu3160 Macro

    Range("J2").FormulaR1C1 = _
        "='[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C25"
    Range("J2").AutoFill Destination:=Range("J2:J2000")

' Echu6190 Macro

    Range("K2").FormulaR1C1 = _
        "='[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C26"
    Range("K2").AutoFill Destination:=Range("K2:K2000")

' Echu90 Macro

    Range("L2").FormulaR1C1 = _
        "='[SOC1.XLSX]AR Outstanding Summary In Local'!R[20]C27"
    Range("L2").AutoFill Destination:=Range("L2:L2000")

' TotEncours Macro

    Range("F2").FormulaR1C1 = "=RC[1]+RC[2]"
    Range("F2").AutoFill Destination:=Range("F2:F2000")

' PourcentageEchu Macro

    Range("M2").FormulaR1C1 = "=(RC[-5]/RC[-7])*100"
    Range("M2").AutoFill Destination:=Range("M2:M2000")

'''''''''''''''''''''''
'''SOC2'''
'''''''''''''''''''''''

' Entite Macro

    Range("B2001").FormulaR1C1 = _
        "=SUBSTITUTE('[SOC2.XLSX]AR Outstanding Summary In Local'!R1C2,'[SOC2.XLSX]AR Outstanding Summary In Local'!R1C2,""SOC2 BV"")"
    Range("B2001").AutoFill Destination:=Range("B2001:B4000")

' Code Macro

    Range("C2001").FormulaR1C1 = _
        "='[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C3"
    Range("C2001").AutoFill Destination:=Range("C2001:C4000")

' RaisonSociale Macro

    Range("D2001").FormulaR1C1 = _
        "='[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C4"
    Range("D2001").AutoFill Destination:=Range("D2001:D4000")

' NonEchu Macro

    Range("G2001").FormulaR1C1 = _
        "=SUM('[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C19:R[-1979]C22)"
    Range("G2001").AutoFill Destination:=Range("G2001:G4000")

' TotEchu Macro

    Range("H2001").FormulaR1C1 = _
        "=SUM('[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C24:R[-1979]C27)"
    Range("H2001").AutoFill Destination:=Range("H2001:H4000")

' Echu130 Macro

    Range("I2001").FormulaR1C1 = _
        "='[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C24"
    Range("I2001").AutoFill Destination:=Range("I2001:I4000")

' Echu3160 Macro

    Range("J2001").FormulaR1C1 = _
        "='[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C25"
    Range("J2001").AutoFill Destination:=Range("J2001:J4000")

' Echu6190 Macro

    Range("K2001").FormulaR1C1 = _
        "='[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C26"
    Range("K2001").AutoFill Destination:=Range("K2001:K4000")

' Echu90 Macro

    Range("L2001").FormulaR1C1 = _
        "='[SOC2.XLSX]AR Outstanding Summary In Local'!R[-1979]C27"
    Range("L2001").AutoFill Destination:=Range("L2001:L4000")

' TotEncours Macro

    Range("F2001").FormulaR1C1 = "=RC[1]+RC[2]"
    Range("F2001").AutoFill Destination:=Range("F2001:F4000")

' PourcentageEchu Macro

    Range("M2001").FormulaR1C1 = "=(RC[-5]/RC[-7])*100"
    Range("M2001").AutoFill Destination:=Range("M2001:M4000")

'''''''''''''''''''
'''SOC3'''
'''''''''''''''''''

' Entite Macro

    Range("B4001").Select
    ActiveCell.FormulaR1C1 = _
        "=SUBSTITUTE('[SOC3.XLSX]AR Outstanding Summary In Local'!R1C2,'[SOC3.XLSX]AR Outstanding Summary In Local'!R1C2,""SOC3"")"
    Range("B4001").Select
    Selection.AutoFill Destination:=Range("B4001:B6000")
    Range("B4001:B6000").Select

' Code Macro

    Range("C4001").Select
    ActiveCell.FormulaR1C1 = _
        "='[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C3"
    Range("C4001").Select
    Selection.AutoFill Destination:=Range("C4001:C6000")
    Range("C4001:C6000").Select

' RaisonSociale Macro

    Range("D4001").Select
    ActiveCell.FormulaR1C1 = _
        "='[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C4"
    Range("D4001").Select
    Selection.AutoFill Destination:=Range("D4001:D6000")
    Range("D4001:D6000").Select

' NonEchu Macro

    Range("G4001").Select
    ActiveCell.FormulaR1C1 = _
        "=SUM('[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C19:R[-3979]C22)"
    Range("G4001").Select
    Selection.AutoFill Destination:=Range("G4001:G6000")
    Range("G4001:G6000").Select

' TotEchu Macro

    Range("H4001").Select
    ActiveCell.FormulaR1C1 = _
        "=SUM('[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C24:R[-3979]C27)"
    Range("H4001").Select
    Selection.AutoFill Destination:=Range("H4001:H6000")
    Range("H4001:H6000").Select

' Echu130 Macro

    Range("I4001").Select
    ActiveCell.FormulaR1C1 = _
        "='[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C24"
    Range("I4001").Select
    Selection.AutoFill Destination:=Range("I4001:I6000")
    Range("I4001:I6000").Select

' Echu3160 Macro

    Range("J4001").Select
    ActiveCell.FormulaR1C1 = _
        "='[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C25"
    Range("J4001").Select
    Selection.AutoFill Destination:=Range("J4001:J6000")
    Range("J4001:J6000").Select

' Echu6190 Macro

    Range("K4001").Select
    ActiveCell.FormulaR1C1 = _
        "='[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C26"
    Range("K4001").Select
    Selection.AutoFill Destination:=Range("K4001:K6000")
    Range("K4001:K6000").Select

' Echu90 Macro

    Range("L4001").Select
    ActiveCell.FormulaR1C1 = _
        "='[SOC3.XLSX]AR Outstanding Summary In Local'!R[-3979]C27"
    Range("L4001").Select
    Selection.AutoFill Destination:=Range("L4001:L6000")
    Range("L4001:L6000").Select

' TotEncours Macro

    Range("F4001").Select
    ActiveCell.FormulaR1C1 = "=RC[1]+RC[2]"
    Range("F4001").Select
    Selection.AutoFill Destination:=Range("F4001:F6000")
    Range("F4001:F6000").Select

' PourcentageEchu Macro

    Range("M4001").Select
    ActiveCell.FormulaR1C1 = "=(RC[-5]/RC[-7])*100"
    Range("M4001").Select
    Selection.AutoFill Destination:=Range("M4001:M6000")
    Range("M4001:M6000").Select

''''''''''''''''''
'''Optimisation'''
''''''''''''''''''
Application.Calculation = savcal
    Application.ScreenUpdating = True
    MsgBox "Durée : " & (Timer - timerdebut) & " sec."

End Sub

Bonjour h2so4,

Merci beaucoup pour ton aide sur 2 société je passe de 3.3 secondes à 0.49

Maintenant il faut savoir que j'ai un total de 27 société voir plus qui vont s'ajouter au fur et à mesure du temps.

J'aimerai savoir si il est possible de créer une boucle qui m'éviterai de recopier le code pour chaque société car il faut avouer que la macro devient vitre très longue.

Cordialement

Je cherche également un moyen que sa lise le nombre exact de ligne du fichier d'extraction (que sa lise 200 lignes par exemple au lieu de 2000)

Je viens de remarquer, je suis obligé de passer de manuel à automatique ou mes calculs ne marche pas , est-ce normal ?

re-bonjour,

en fait la macro se charge de cette opération, au début elle sauve le mode de calcul tel qu'il est au moment de l'éxecution de la macro, puis elle met le mode calcul en manuel et à la fin de la macro elle remet le mode de calcul dans on état initial (celui sauvegardé au début).

si avant de lancer la macro, le mode de calcul est manuel, la macro restituera le mode de calcul manuel en fin de macro.

si avant de lancer la macro, le mode de calcul est automatique, la macro restituera le mode de calcul automatique en fin de macro.

si avant de lancer la macro, le mode de calcul est semi-manuel, la macro restituera le mode de calcul semi-manuel en fin de macro.

re-bonjour,

Je cherche également un moyen que sa lise le nombre exact de ligne du fichier d'extraction (que sa lise 200 lignes par exemple au lieu de 2000)

pour ceci merci de mettre un fichier exemple de ta consolidation et 2 fichiers exemples à consolider. quelques lignes suffisent.

D'accord merci beaucoup avec tes indications j'ai pu mettre ça à jour merci

Je publie le nouveau fichier demain matin, je n'ai y est plus accès pour le moment

Salut H2so4 voici un exemple des fichiers à consolider dans le fichier "TransfertCWtoCumul" j'ai mis les 3 première société que la macro récupère

(dans soc1 il n'y a pas de donnée, c'est normal il n'y en à pas encore pour ce mois-ci)

bonjour,

une proposition, j'ai ajouté une feuille paramètre qui devra contenir la liste des fichiers à consolider et le nom à leur associer

Incroyable ca marche ! Merci beaucoup ca va me faire gagner pas mal de temps.

J'ai remarqué que ta macro ouvre le fichier puis le ferme, il y a t'il possibilité de dire à la macro de faire fermé sans enregistré au lieu de le faire manuellement ?

C'est également super sympa d'avoir mis les commentaires dans la macro :)

Finalement il y a un problème, quand nous avons plusieurs société qui apparait, le montant des sociétés n'est plus bon cf soc3 qui apparait tout en bas ont voit que l'échu n'est plus bon et que les formules sont mal gérer.

bonjour,

voici une correction

ça marche parfaitement, je ne vois plus aucune erreur, merci beaucoup pour ton aide précieuse