Bonjour a vous,


J'ai un code qui est utilisé, il fonctionne a merveille mais il est trop lent, vraiment beaucoup. Comme ils s'agit d'information transposé dans un autre endroit j'ai essayé de copie des row ou des range. J'ai fait quelque tentative infructueuse et en fouillant que je devrais utilisé les array. J'ai vu un video sur le web de wiseowl tutoriel et aussi lu celui de silkyroad. Étant donné que je suis vraiment novice en terme de concept de Array, je vous solicite pour votre aide. Tous les exemple que j'ai vu ne correspondent pas vraiment a ma situation et je ne comprends pas toute a fais a 100% le concept et l'utilisation de celui-ci. Je me retrouve donc avec une piste de solution sans la comprendre. Pour la dimension je ne sais pas si c'Est une seul et unique ou 2. Comme vous voyez je part de loins

TOus les exemple que j'ai vu prenait un tableau effectuais des tri et le copiais entièrement dans une nouvelle emplacement. Je n'ai malheureusement pas vu de cas auquel on appliquais un critère pour le resultats. Donc est ce possible ou avez vous une idée autre afin d'amélioré le code
'on copie les données dans la feuille correspondantes
qui est le boulet de ma sub ???




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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Sub genere_onglets_etablissement()
 
'    On Error GoTo errorhandler:
 
    Dim x As Integer
    Dim LettreVoulue As String
    LettreVoulue = TrouveLettreColonne([acronyme_etab])
    Dim nom_etablissement As Variant
    Dim entete As Range
    Dim start As Single
    Dim finish As Single
 
    start = Timer
 
    Application.ScreenUpdating = False
 
'nettoie le nom des etablissements provenant du LAC afin d'éviter d'avoir 2 onglets
 
    Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet("R_MoulinetteAValider")).Select
    nettoyerseul
 
'détruire onglet si ré-exécution de la macro
 
    detruire_onglet_etablissement
 
'création des feuilles selon le nom des etablissement
 
    For Each nom_etablissement In Sheets("R_MoulinetteAValider").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
    x = x + 1
 
        If Cells(x + 1, [valider_etablissement].Column) = "x" Or Cells(x + 1, [valider_etablissement].Column) = "X" Then
 
                If sheetExists(nom_etablissement.value) = True Then
 
                Else
 
                    Sheets.Add.Name = nom_etablissement
                    Sheets("R_MoulinetteAValider").[ID_titre].Copy Sheets(nom_etablissement.value).Range("a1")
                    Sheets("R_MoulinetteAValider").[seq_titre].Copy Sheets(nom_etablissement.value).Range("b1")
                    Sheets("R_MoulinetteAValider").[pair_impair_titre].Copy Sheets(nom_etablissement.value).Range("c1")
                    Sheets("R_MoulinetteAValider").[etab_titre].Copy Sheets(nom_etablissement.value).Range("d1")
                    Sheets("R_MoulinetteAValider").[acronyme_etab_titre].Copy Sheets(nom_etablissement.value).Range("e1")
                    Sheets("R_MoulinetteAValider").[item_etab_moulinette_titre].Copy Sheets(nom_etablissement.value).Range("f1")
                    Sheets("R_MoulinetteAValider").[item_etab_titre].Copy Sheets(nom_etablissement.value).Range("g1")
                    Sheets("R_MoulinetteAValider").[descr_etab_titre].Copy Sheets(nom_etablissement.value).Range("h1")
                    Sheets("R_MoulinetteAValider").[couleur_etab_titre].Copy Sheets(nom_etablissement.value).Range("i1")
                    Sheets("R_MoulinetteAValider").[four_etab_titre].Copy Sheets(nom_etablissement.value).Range("j1")
                    Sheets("R_MoulinetteAValider").[fournisseur_titre].Copy Sheets(nom_etablissement.value).Range("k1")
                    Sheets("R_MoulinetteAValider").[marque_etab_titre].Copy Sheets(nom_etablissement.value).Range("l1")
                    Sheets("R_MoulinetteAValider").[cat_etab_titre].Copy Sheets(nom_etablissement.value).Range("m1")
                    Sheets("R_MoulinetteAValider").[format_contrat_titre].Copy Sheets(nom_etablissement.value).Range("n1")
                    Sheets("R_MoulinetteAValider").[qte_an_titre].Copy Sheets(nom_etablissement.value).Range("o1")
                    Sheets("R_MoulinetteAValider").[prix_contrat_titre].Copy Sheets(nom_etablissement.value).Range("p1")
                    Sheets("R_MoulinetteAValider").[valider_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("q1")
                    Sheets("R_MoulinetteAValider").[commentaire_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("r1")
                    Sheets("R_MoulinetteAValider").[commentaire_etablissement_titre].Copy Sheets(nom_etablissement.value).Range("s1")
 
                     Range("s1").value = "Reponse de l'etablissement"
                     Columns("a:C").ColumnWidth = 6.11
                     Columns("D").ColumnWidth = 8.33
                     Columns("E").ColumnWidth = 15.78
                     Columns("F").ColumnWidth = 11.89
                     Columns("G").ColumnWidth = 15.78
                     Columns("H").ColumnWidth = 40
                     Columns("I:P").ColumnWidth = 15.78
                     Columns("Q").ColumnWidth = 11.89
                     Columns("R:U").ColumnWidth = 40
 
                     Range("a2").Activate
 
                End If
 
 'on copie les données dans la feuille correspondantes
 
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [ID].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 1)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [seq].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 2)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [pair_impair].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 3)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 4)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [acronyme_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 5)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [item_etab_moulinette].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 6)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [item_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 7)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [descr_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 8)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [couleur_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 9)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [fourn_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 10)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [Fournisseur].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 11)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [marque_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 12)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [cat_etab].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 13)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [format_contrat].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 14)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [qte_an].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 15)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [prix_contrat].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 16)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [valider_etablissement].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 17)
                    Sheets("R_MoulinetteAValider").Cells(x + 1, [commentaire_etablissement].Column).Copy Sheets(nom_etablissement.value).Cells(x + 1, 18)
 
'on supprime les lignes vides si bien sur les feuilles ont été créés
 
                    Sheets(nom_etablissement.value).Select
                    Range("A2").EntireRow.Insert
                    Sheets(nom_etablissement.value).Range("b1:B" & LastLignUsedInColumn("B")).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                    With ActiveSheet.Tab
                        .ThemeColor = xlThemeColorAccent3
                        .TintAndShade = 0.399975585192419
                    End With
        End If
 
    Sheets("R_MoulinetteAValider").Select
 
    Next nom_etablissement
 
finish = Timer
 
MsgBox "durée du traitement: " & finish - start & " secondes"
 
Exit Sub
 
errorhandler:
MsgBox "Erreur d'exécution, la procédure va se terminer !", vbCritical
 
End Sub


merci encore pour votre aide, commentaires, références a d'autre ouvrage et surtout votre temps !!!



amicalement JP