Discussion :

[mikadoo57]

Bonjour,
j'ai un fichier, appelé "synthèse" qui va récupérer 8 tableaux identiques dans 8 dossiers différents (1 par dossier), qui copie chaque tableau dans une feuille et fait la fusion des données sur une autre feuille.
J'ai cherché à améliorer mes macros pour les accélérer mais le seul effet obtenu a été sur le volume du fichier qui, une fois la macro exécutée, est de +/- 36Mo alors qu'avant modification des macros il était de +/- 2Mo.
Voici les macros telles qu'elles étaient initialement:
importation des données (cette macro est répétée 8 fois, une pour chaque dossier) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub import()
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="F:\...\fichier Paris.xls"
       Worksheets("Activités").Range("B3:N1202").Copy
         Windows("synthèse.xls").Activate
           Worksheets("Activité Paris").Activate
           Range("B3").Select
          Selection.PasteSpecial Paste:=xlPasteValues
          Selection.PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
    Windows("fichier Paris.xls").Close savechange = False
end sub

Fusion des données:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub CommandButton2_Click()
    Call import
    Dim Lig1 As Integer         'Lig1 est un entier
    Dim Col1 As Integer         'Col1 est un entier
    Dim MaFeuille As Worksheet  'MaFeuille est une feuille
    Dim Ligne As Integer        'Ligne est un entier
 
    Application.ScreenUpdating = False
    Feuil1.Range("A3:N6002").Cells.Clear
 
    Lig1 = 3
        For Each MaFeuille In Sheets  
        If MaFeuille.Name Like "Act*" Then 
            With MaFeuille
                 For Ligne = 3 To .UsedRange.Row + .UsedRange.Rows.Count
                   If .Cells(Ligne, 2) <> "" Then
                         For Col1 = 1 To 14
                             Feuil1.Cells(Lig1, Col1).Value = .Cells(Ligne, Col1).Value
                         Next
                         Lig1 = Lig1 + 1
                     End If
                 Next
            End With
          End If
    Next
 
Call format 'macro pour insérer des bordures et centrer des colonnes car la simple copie ne me donne que les valeurs
 
    Application.ScreenUpdating = True   'pour libérer l'affichage
End Sub

Voici les lignes après modifications :
importation des données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Workbooks.Open Filename:="F:\...\fichier Paris.xls"
        Worksheets("Activités").Range(Range("B3"), Range("N1202").End(xlDown)).Copy

fusion des données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  With mafeuille
                 For Ligne = 3 To 1202

et je n'arrive pas à savoir quelle macro (import, fusion ou format) fait subitement grossir mon fichier.
Merci pour votre aide.

[Oliv-]

Je ne vois rien d'évident
mais tu peux essayer à la fin cette macro qui supprime les clignes et colonnes vides en bout de feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Sup_Col_Lignes_Vides_fin()
'http://en.allexperts.com/q/Excel-1059/2008/7/Excel-blank-sheets.htm
    If MsgBox("Supprime le ligne et colonnes vide en fin de tableau pour diminuer la taille du fichier", vbYesNo, "Continuer") = vbNo Then Exit Sub
    Dim ws As Worksheet
    Dim lastrow As Long, lastcol As Long
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            lastrow = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lastcol = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            Range(.Cells(1, lastcol + 1), .Cells(Rows.Count, Columns.Count)).Delete
            Range(.Cells(lastrow + 1, 1), .Cells(Rows.Count, Columns.Count)).Delete
            lastrow = .UsedRange.Rows.Count
        End With
    Next ws
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

[mikadoo57]

Bonjour, effectivement, je ne comprend pas car la macro modifiée n'importe pas les 1200 lignes (vides ou pas) mais uniquement les non vides.
J'essaye ton code et je te tiens au courant. Merci

[mikadoo57]

IMPRESSIONNANT !
Mon fichier a maigri de 36Mo à 1,6Mo !
Je note ce code dans mon répertoire pour m'en resservir au besoin car très utile.
Merci

[mikadoo57]

J'ai ôté l'option "résolu" car j'ai identifié la macro coupable en l'exécutant seule : c'est celle qui importe les tableaux des autres dossiers.
le fait de passer de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Worksheets("Activités").Range("B3:N1202").Copy

à

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Worksheets("Activités").Range(Range("B3"), Range("N1202").End(xlDown)).Copy

multiplie la taille du fichier par 5 !
Pourquoi? si quelqu'un à la réponse...

[Oliv-]

c'est le xlDown