Discussion :

[mikadoo57]

Bonjour,
je voudrai optimiser une macro assez chronophage mais sans en avoir les compétences, donc je me retourne vers vous.
Cette macro (un grand merci à AVSInfoGest ) est chargée de copier et fusionner dans une feuille de synthèse les lignes non vides de 8 tableaux (de 1200 lignes max) situés sur 8 feuilles du classeur. Le code est le suivant :

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
Private Sub CommandButton2_Click()
 
    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 'les feuilles concernées portent toutes un nom commançant par "Activités de..."
            With MaFeuille
                 For Ligne = 3 To .UsedRange.Row + .UsedRange.Rows.Count 'pour info, en mettant ...=3 To 1200, le temps d'exécution est le même
                   If .Cells(Ligne, 2) <> "" Then
                         For Col1 = 1 To 14 'chaque tableau à 14 colonnes
                             Feuil1.Cells(Lig1, Col1).Value = .Cells(Ligne, Col1).Value
                         Next
                         Lig1 = Lig1 + 1
                     End If
                 Next
            End With
          End If
    Next
 
    Application.ScreenUpdating = True 
End Sub

j'ai l'impression que la recherche ligne par ligne en est la raison et si quelqu'un à une solution, je suis preneur.
Merci

[Daniel.C]

Bonjour,

Non testé; si , comme probable, ça plante, pourras-tu mettre un classeur réduit en PJ ?

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()
 
    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
    Dim Result(6000, 14)
    Dim Tabl
 
    Application.ScreenUpdating = False
    Feuil1.Range("A3:N6002").Cells.Clear
    lig = 1
        For Each MaFeuille In Sheets
        If MaFeuille.Name Like "Act*" Then 'les feuilles concernées portent toutes un nom commançant par "Activités de..."
            With MaFeuille
                 Tabl = .Range(.Cells(1, 1), .Cells(.Find("*", , , , xlByRows, xlPrevious).Row, 14))
                 For Ligne = 3 To UBound(Tabl) 'pour info, en mettant ...=3 To 1200, le temps d'exécution est le même
                   If Tabl(Ligne, 2) <> "" Then
                         For Col1 = 1 To 14 'chaque tableau à 14 colonnes
                             Result(Lig1, Col1).Value = Tabl(Ligne, Col1).Value
                         Next
                         Lig1 = Lig1 + 1
                     End If
                 Next
            End With
          End If
    Next
    Feuil1.[A3].Resize(6000, 14) = Result
    Application.ScreenUpdating = True
End Sub

[mikadoo57]

Je viens de tester.
j'ai laissé la ligne 11 de mon code tel quel car tu écris lig=1 mais lig n'est pas défini et ne se retrouve pas dans le code.
Le code bute le mot 'Find' de la ligne 11 (membre de méthode ou de données introuvable). Je ne suis pas trop surpris car le mot Find n'est pas proposé par l'intellisense lors de la frappe.

[Daniel.C]

peux-tu mettre un classeur exemple en PJ ?

[mikadoo57]

Pas possible depuis le taf car Intranet protégé et sur la console internet (depuis laquelle j'écris), seul Open office est installé.
Je vois cela ce soir depuis chez moi. Merci

[Theze]

Bonsoir,

Comme pas de pj, regarde le code ci-dessous et test si plus rapide. Il te faut probablement adapter donc fait un test de préférence sur une copie de ton classeur :

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
31
32
33
34
35
36
 
Private Sub CommandButton2_Click()
 
    Dim Lig1 As Integer
    Dim MaFeuille As Worksheet
    Dim Cel As Range
 
    Application.ScreenUpdating = False
 
    Feuil1.Range("A3:N6002").Clear
 
    Lig1 = 3
 
    For Each MaFeuille In Sheets
 
        If MaFeuille.Name Like "Act*" Then 'les feuilles concernées portent toutes un nom commançant par "Activités de..."
 
            With MaFeuille
 
                For Each Cel In .UsedRange.Columns(2).Cells.SpecialCells(xlCellTypeConstants)
 
                    Feuil1.Range(Feuil1.Cells(Lig1, 1), Feuil1.Cells(Lig1, 14)).Value = .Range(Cel.Offset(, -1), .Cells(Cel.Row, 14)).Value
 
                    Lig1 = Lig1 + 1
 
                Next
 
            End With
 
        End If
 
    Next MaFeuille
 
    Application.ScreenUpdating = True
 
End Sub

Hervé.