probleme aleatoire + optimisation de ce meme code

Bonjour a vous,

Mon problème et questionnement d'aujourd'hui pose sur le même code. je ne sais pas si j'aurais du 2 discussions ou seulement une. Bref, j'ai un code qui fonctionne a merveille en première vu, le seule hic c'est lorsque je le ré exécute a plusieurs reprises, il y a un problème qui surgi mais parfois ca ne le fait pas ... j'ai essayé a plusieurs endroit de remettre a zéro les variable mais j'arrive toujours a le même résultat. Apres 3 heures d'essaie et erreur étant donné que je ne suis pas sur ce qui cloche, je vous contactes afin d'éviter la crise de nerfs !!!

Donc en résume, j'ai une feuille auquel si j'ai un x dans une colonne spécifique, je valide si l'onglet de l'établissement en question existe. Si l'onglet existe déjà, on la supprime (au cas ou que l'on refais le code). Par la suite avec toujours le même X je copie des informations dans l'onglet propre a chacun des noms d'établissements. Ce que je tombe c'est si je clique 3 fois sur l'exécution de la sub, dans l'onglet correspondant aux établissement ayant un X, j'ai trois fois la meme informations. Parfois ca marche numéro un et des fois pas. Je n'est malheureusement pas trouvé de pattern en question. J'ai supposé que je devais mettre a zéro la variable X mais cela ne fonctionne pas, j'ai également changé le nom de certaines variable qui est utilisé dans un code dans le meme module mais ca nefonctionne pas plus. EN jouant avec les couleurs d'onglet, je comprends qu'il ne détruis pas les onglets existant et ce de façon aléatoire.

Code:

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

Voici le code de la sub qui est impregné dans celle dans haut. J'avais jadis fait ceci afin de facilité la lecture du code evité les erreurs de variable nom vide. COmme vous pouvez le constaté il se peut que cela ne fonctionne pas. LE code est exécuté dans un complément mais je ne sais pas non plus si ceci est la cause de mes soucis.

Code:

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
Sub detruire_onglet_etablissement()
 
 
    Dim LettreVoulue As String
    LettreVoulue = TrouveLettreColonne([acronyme_etab])
    Dim nom_etablissement As Variant
 
    Application.ScreenUpdating = False
 
 
    For Each nom_etablissement In Sheets("R_MoulinetteAValider").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
 
 
                If sheetExists(nom_etablissement.value) = False Then
 
 
                Else
 
                    Application.DisplayAlerts = False
                    Sheets(nom_etablissement.value).Delete
                    Application.DisplayAlerts = True
                End If
 
 
    Sheets("R_MoulinetteAValider").Select
 
    Next nom_etablissement
 
 
End Sub

La seconde parti de mon probleme c'Est que je voudrais optimiser celui-ci afin de pouvoir gagné du temps d'exécutions. Je fais une premiere boucle suivi d'une qui est tres lentes. Je presume que nous pourrions copier des lignes de code mais étant donné que les informations ne sont pas coller coller, je ne sais pas si c'est possible (pratiquement tout est possible mais bon :) )
Donc est-ce que vous auriez des piste de solutions ou des références afin que je puisse faire le tout. Mon but premier était d'optimiser le code mais c'est en faisait des test que j'ai eu des problemes. Toute mes tentatives de nommer des plages avaient également pas fonctionné. Donc au lieu D'etre a 0 je suis a -1