XL 2010 Macro qui fait grossir fichier Excel

[Banjounet]

Bonjour à tous,

J'ai un problème avec une macro et je n'arrive pas à trouver une solution...
je vous explique :
J'ai un bouton "MiseAJour" qui effectue l'enchainement de macro suivant:

Sub RemplissageTableau()
Application.ScreenUpdating = False
Dim c As Range
Dim EffNec
EffNec = "=IF(OR(RC13=""AGPRO"",RC13=""AGTEC"",RC13=""AGING"",RC13=""AGAPP""),0,RC[-2])"
For I = 11 To Sheets.Count
     With Sheets(I)
     .Columns("T:U").ClearContents
        For Each c In .Range("T1:U" & .Range("S" & Rows.Count).End(xlUp).Row)
        c.Formula = EffNec
        Next c
     End With
Next I
Total
End Sub
_____________________________________________________
Sub Total()
Dim LastLig As Long, Deb As Long, Fin As Long
Dim T As Double, U As Double
Dim Prem As String
Dim c As Range
For I = 11 To Sheets.Count
With Sheets(I)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set c = .Range("B2:B" & LastLig).Find("Total*", LookIn:=xlValues, lookat:=xlPart)
    Deb = 2
    If Not c Is Nothing Then
        Prem = c.Address
        Do
            Fin = c.Row - 1
            .Range("T" & Fin + 1).Formula = "=SUMIF(E" & Deb & ":E" & Fin & ",""<>"",T" & Deb & ":T" & Fin & ")"
            .Range("U" & Fin + 1).Formula = "=SUM(U" & Deb & ":U" & Fin & ")"
            Deb = Fin + 2
            T = T + .Range("T" & Fin + 1)
            U = U + .Range("U" & Fin + 1)
            Set c = .Range("B2:B" & LastLig).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Prem
    End If
    .Range("T" & LastLig).Resize(, 2) = Array(T, U)
    T = 0
    U = 0
End With
Next I
MiseEnForme
End Sub
_______________________________________________________________
Sub MiseEnForme()
   
For I = 11 To Sheets.Count
With Sheets(I)
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("E1:E" & LastLig).Copy
    .Range("D1:V" & LastLig).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    '.Columns("A:V").AutoFit
    .Range("A1:Q" & LastLig).HorizontalAlignment = xlLeft
    .Range("T1:U" & LastLig).HorizontalAlignment = xlRight
    .Range("R1:S" & LastLig).EntireColumn.Hidden = True
    .Range("R1:S" & LastLig).EntireColumn.Hidden = True
    .Range("V1:V" & LastLig).ColumnWidth = 40
    .Range("L1:L" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("H1:H" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("O1:O" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("Q1:Q" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("D1:D" & LastLig).EntireColumn.Hidden = True
'Mise en forme Ligne
    .Rows("1:1").HorizontalAlignment = xlCenter
    .Rows("1:1").VerticalAlignment = xlCenter
End With
Next I
End Sub

Tout fonctionne très bien jusqu'à la macro MiseEnForme. Même si celle ci fonctionne, à chaque fois que je l'active, celle ci fait grossir mon fichier (+80K environ à chaque utilisation), le rendant de plus en plus lent et au final inutilisable.

Sur les conseil d'une personne j'ai rajouté le code suivant, pour voir ou s'exécute la macro:

MsgBox .UsedRange.Address

Et celle ci s'exécute bien dans les dimension voulue...

Je ne sais pas d'où viens le problème et j'ai cherché sans trop trouver de solution convenable. j'ai donc besoin de votre aide

Je suis désolé si je ne me fait mal comprendre ou si mon code est pas lisible ou mal opti, je suis en apprentissage . Si jamais je reformulerai en cas de besoin

Un grand merci d'avance à ceux qui voudrons bien m'aider, je mets en pièce jointe un fichier test avec le problème en question.

 

[job75]

Bonjour Banjounet,

Le fichier prend 380 Ko après chaque exécution des 3 macros.

J'ai pu vérifier qu'en est responsable la macro MiseEnForme et uniquement à cause de ces 2 lignes de codes :

    .Range("A1:Q" & LastLig).HorizontalAlignment = xlLeft
    .Range("T1:U" & LastLig).HorizontalAlignment = xlRight

A mon avis cette macro est inutile : faites une fois pour toutes une mise en forme manuelle sur les colonnes entières.

A+

 

[Banjounet]

Bonjour Job,
Un très grand merci pour ta réponse

J'en suis arrivé à la même conclusion et je vais appliquer ta solution, qui bien évidemment ne ma juste pas sauter au yeux alors que c'est quand même évident
Puis je abuser encore un peu de ton temps car un deuxième problème du même type viens d'apparaitre...
Sur ce fichier j'ai donc le module "FormuleEtMEF", l'enchainement des 3 macros, et un 2e module "BaseTravail" qui s'exécute grâce à un ToggleButton.

Avec ta modification , si j'éxecute la macro "FormuleEtMEF" puis "BaseTravail" le fichier ne prend pas de poids.
Mais si je fais l'inverse, utilisation normal du fichier, celui ci prend du poids...
J'ai bloqués les lignes unes part unes et je n'ai pas trouvé de raison à cela...
Décidemment je dois avoir un complexe de poids qui se répercute même sur mes fichiers Excel

Encore merci pour ton aide

 

[job75]

Contrairement à ce que vous dites, en supprimant la macro MiseEnForme, je ne vois pas d'augmentation de poids.

 

[Banjounet]

Autant pour moi j'avais mal compris le message.
J'ai lu que vous préconisiez de supprimer uniquement les 2 lignes:

 .Range("A1:Q" & LastLig).HorizontalAlignment = xlLeft
     .Range("T1:U" & LastLig).HorizontalAlignment = xlRight

Et pas la macro entière. Effectivement si l'on supprime la macro entière le problème est reglé.
Le problème est que dans un soucis de facilité de lecture, la personne qui à besoin du fichier voudrais avoir un visuel comme desssous;

Où au niveau du numéro de poste 9800200539 on voit que l'ensemble de la ligne ne possède pas de trait interne.
Le problème est que si je modifie les valeurs dans la source de données du TCD (ce qui est le cas toutes les semaine) je dois tout actualiser pour mettre à jour les TCD. Et la mise en forme redeviens comme ci dessous:

On à ce trait rouge qui reviens à chaque fois et sur toutes les lignes ayant une mise en forme similaires. C'est pour ça que je ne peux pas me passer de la macro MiseEnForme. Si ça ne dépendais que de moi cela ne me dérangerais pas. Mais comme c'est pas moi qui décide

 

[job75]

Re,

Avec cette macro je n'observe pas d'augmentation de poids :

Sub MiseEnForme()
For I = 11 To Sheets.Count
    With Sheets(I)
        .Columns("E").Copy
        .Columns("D:V").PasteSpecial xlPasteFormats
        Application.CutCopyMode = False

        '.Columns("A:Q").HorizontalAlignment = xlLeft
        '.Columns("T:U").HorizontalAlignment = xlRight
        .Columns("R:S").Hidden = True
        .Columns("V").ColumnWidth = 40
        .Range("L:L,H:H,O:O,Q:Q").NumberFormat = "dd/mm/yyyy"
        .Columns("D").Hidden = True
        .Rows(1).HorizontalAlignment = xlCenter
        .Rows(1).VerticalAlignment = xlCenter
    End With
Next I
End Sub

Edit : il est mieux de faire le copier-coller sur les colonnes entières.

A+

 

[Banjounet]

Je viens de me rendre compte que je ne t'avais pas répondu ! Shame on me !

Un immense merci ! Ta solution fonctionne parfaitement !
Je ne sais pas d'où venez le problème mais tant pis !

Une très bonne continuation à toi et encore un immense merci pour ton aide précieuse !