La macro ou le code ne s'exécute pas dans le module

**PPN83** · 12/10/2014, 15h34

Bonjour,
voilà plusieurs jours que je bute sur un problème pour l'instant inexplicable pour moi.
1/ le code ci dessus s'exécute correctement mais n’exécute pas la macro "Insérer" (ligne (97).
2/ si je copie le code de la macro "Insérer" dans la macro "création_chaîne" à ligne (97) le code ne fonctionne pas non plus mais la macro continue jusqu'à la ligne 106.
3/ mais si j'exécute à partir de la macro"Insérer" le code fonctionne.

En espérant avoir été clair, merci d'avance de vos réponses.

Cordialement

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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Sub création_chaîne()
 
Dim ctr As Integer
Dim ctr1 As Integer
Dim ctr2 As Integer
Dim reponse As String
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
Sheets("Workflow").Select
 
If Range("H2").Value = "Chaîne" Then
    reponse = MsgBox("La Chaîne est déjà créée voulez vous la supprimer et la remplacer ?", vbExclamation + vbYesNo, "ATTENTION")
    If reponse = vbNo Then Exit Sub
    If reponse = vbYes Then
        Columns("H:H").Select
        Selection.Delete Shift:=xlToLeft
        Sheets("Liste Chaîne").Select
        Range("A2:G2").Select
        Range(Selection, Selection.End(xlDown)).Select  'Correspond au F8 CTRL + flêche(BAS)
        Selection.ClearContents
        Sheets("entretien").Select
        Range("A2:c2").Select
        Range(Selection, Selection.End(xlDown)).Select  'Correspond au F8 CTRL + flêche(BAS)
        Selection.ClearContents
        Sheets("acces_appli").Select
        Range("A2:E2").Select
        Range(Selection, Selection.End(xlDown)).Select  'Correspond au F8 CTRL + flêche(BAS)
        Selection.ClearContents
        Sheets("Workflow").Select
        Range("H2").Select
    End If
End If
 
Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.NumberFormat = "@" ' format texte
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Chaîne" 'écriture de l'en tête de colonne
 
ctr = 0
ctr1 = 0
ctr2 = 0
 
For n = 3 To 1200
    If Cells(n, 1) = "" Then GoTo 10
    If Cells(n - 1, 1) <> Cells(n, 1) Then ctr = 0   'changement de département mise à zéro du compteur
 
    If Cells(n - 1, 10) <> Cells(n, 10) Then           'à chaque changement d'évaluateur le compteur ajoute 1
        ctr = ctr + 1
        If ctr < 10 Then
        Cells(n, 8).Value = Cells(n, 1) & 0 & ctr           ' permet de rajouter un zéro devant un chiffre < 10
        Else
        Cells(n, 8).Value = Cells(n, 1) & ctr
        End If
    End If
 
    If Cells(n - 1, 10) = Cells(n, 10) Then
        If ctr < 10 Then
        Cells(n, 8).Value = Cells(n, 1) & 0 & ctr
        Else
        Cells(n, 8).Value = Cells(n, 1) & ctr 'pas de changement d'évaluateur, le compteur ne bouge pas
        End If
    End If
 
    Cells(n, 8).Select      'Colorisation de la colonne "Chaîne"
        With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = 2
                .Color = 5296274
                .TintAndShade = 0
                .PatternTintAndShade = 0
        End With
 
    If Cells(n - 1, 8) <> Cells(n, 8) Then
        ctr1 = ctr1 + 1
        Sheets("Liste Chaîne").Cells(1 + ctr1, 1) = Cells(n, 8) ' Copie la chaîne et les matricules dans la feuille "Liste chaîne"
        Sheets("Liste Chaîne").Cells(1 + ctr1, 2) = Cells(n, 9)
        Sheets("Liste Chaîne").Cells(1 + ctr1, 3) = Cells(n, 11)
        Sheets("Liste Chaîne").Cells(1 + ctr1, 4) = Cells(n, 13)
        Sheets("Liste Chaîne").Cells(1 + ctr1, 5) = Cells(n, 15)
        Sheets("Liste Chaîne").Cells(1 + ctr1, 6) = Cells(n, 17)
        Sheets("Liste Chaîne").Cells(1 + ctr1, 7) = Cells(n, 19)
 
        Sheets("acces_appli").Cells(1 + ctr1, 1) = Cells(n, 9)  ' Copie la liste des matricules ayant l'accès
        Sheets("acces_appli").Cells(1 + ctr1, 2) = Cells(n, 10)
        Sheets("acces_appli").Cells(1 + ctr1, 3) = Cells(n, 21)
        Sheets("acces_appli").Cells(1 + ctr1, 4) = Cells(n, 20)
    End If
 
        Sheets("entretien").Cells(n - 1, 1) = Cells(n, 4)       ' Création des numéros d'entretien
        Sheets("entretien").Cells(n - 1, 2) = "=CONCATENATE(RC[-1],""_ENT_ANN_2014"")"
        Sheets("entretien").Cells(n - 1, 3) = Cells(n, 8)
Next
 
Call Insérer
 
10
 
MsgBox "Création des Chaînes terminée", vbInformation, "INFORMATION"
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
 
 
Sub Insérer()
 
    Sheets("Info").Select
    Rows("10:39").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("acces_appli").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Range("A2").Select
 
   Set MonDico = CreateObject("Scripting.Dictionary")  'Lorsqu'il y a un doublon dans la colonne A il conserve la ligne du premier doublon et supprime la 2ème
  Application.ScreenUpdating = False
  i = 1
  Do While i < [A1048576].End(xlUp).Row
    temp = Cells(i, "a")
    If Not MonDico.Exists(temp) Then
      MonDico(temp) = ""
      i = i + 1
    Else
      Rows(i).EntireRow.Delete
    End If
  Loop
 
 
Range("f1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-5]:R[1200]C[-5])"
 
 
End Sub

**Thautheme** · 12/10/2014, 16h09

Bonjour PPN, bonjour le forum,

Dans la boucle For n = 3 to 1200, si une seule cellule de la plage A3:A1200 est vide, tu renvoies à la ligne 10 qui se situe juste après la ligne Call Insérer.
Je pense que c'est ce qui arrive et que forcément, que ce soit avec le code de la macro Insérer ou la ligne Call Insérer, si une ligne vide est rencontrée elle les ignore. Peut-être te faudrait-il placer la ligne Call Insérer APRÈS la ligne 10...
À éviter aussi, les accents sur les noms des variables en VBA, même si en l'occurrence le problème n'est pas là, Inserer à la place d'Insérer...

**PPN83** · 12/10/2014, 16h31

Bravo, Thautheme çà fonctionne parfaitement après le 10.

Grand merci

A+

La macro ou le code ne s'exécute pas dans le module [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager