Modification de code dû a un besoin different

**zoumzoum59** · 19/01/2018, 11h47

Bonjour a tous,

Je reviens avec une continuité d'une ancienne discussion qui date de prés d'un an, ou Eric KERGRESSE m'avait donné un fier coup de main pour resoudre mon problème, cependant je reviens avec ce projet car mon besoin sur la restitution final a un peu changé.
La discussion était la suivante: https://www.developpez.net/forums/d1...l/aide-boucle/

J'ai bien essayé de regarder de mon coté, mais déjà dans l'analyse du code c'est pas simple malgré que j'ai modifier certaines chose depuis le code du départ.
donc si quelqu'un peut me donner la direction a prendre ça serait génial.
Mon besoin auparavant était de faire le cumul dans une feuille source de dimension correspondant a certaines références qui ce trouvait sur plusieurs feuilles et dans des colonnes identiques.
Maintenant mon besoin reste quasiment le même mais dans la restitution je voudrais avoir le cumul mais par feuille comme présenté ci dessous:

Avant
Nom : resultat précédent.PNG
Affichages : 162
Taille : 17,8 Ko

Nom : resultat précédent.PNG
Affichages : 162
Taille : 17,8 Ko

Apres

Nom : resultat a obtenir.PNG
Affichages : 156
Taille : 18,7 Ko

Le code correspondant a ce qui fonctionne actuellement est celui ci:

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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
Public MaMatrice() As Variant
 
Sub ExtractionCodeSurPlusieursOnglets()
 
    Dim ShCible As Worksheet
    Dim ListeDesOngletsATraiter As Variant
    Dim k As Integer
    Dim i As Integer, j As Integer, l As Integer, Tab_Feuil(), Liste()
  Dim aze
 
 
    For i = 7 To ThisWorkbook.Worksheets.Count
    aze = ActiveWorkbook.Sheets(Sheets(i).Name).Range("N5:Q6500").Value
 
 
        If Sheets(i).Visible And Application.CountA(ActiveWorkbook.Sheets(Sheets(i).Name).Range("N5:Q6500")) <> 0 Then
            ReDim Preserve Tab_Feuil(j)
            Set Tab_Feuil(j) = Sheets(Sheets(i).Name)      '<----- ligne complétée
            j = j + 1
        End If
 
    Next
    Dim lNumElements As Long
 
    lNumElements = UBound(Tab_Feuil) - LBound(Tab_Feuil) + 1
    l = lNumElements - 1
 
 
    Set ShCible = Sheets("Total Chant")
    With ShCible
        .Range(.Cells(1, 1), .Cells(.Rows.Count, 2)).ClearContents
    End With
    ListeDesOngletsATraiter = Tab_Feuil
 
    For k = 0 To l
 
        Extraction_Code ListeDesOngletsATraiter(k)
        RestituerLaMatrice ShCible
 
    Next k
    ' Tri de l'onglet cible....
    Set ShCible = Nothing
 
End Sub
 
Sub Extraction_Code(ByVal FeuilleSource As Worksheet)
 
    Dim MonDico As Object
    Dim C As Range
    Dim DerniereLigne As Long
 
    Dim ListeCle As Variant
    Dim ListeElement As Variant
    Dim i As Integer
    Dim j As Integer
    Dim Tempo1, Tempo2
 
    Set MonDico = CreateObject("Scripting.Dictionary")
 
    With FeuilleSource
        DerniereLigne = .Cells(.Rows.Count, 5).End(xlUp).Row  ' Colonne à adapter
        For Each C In .Range(.Cells(5, 14), .Cells(DerniereLigne, 17))
            If Not MonDico.Exists(C.Value) And C.Value <> "" Then MonDico.Add C.Value, C.Value
        Next C
        'Stop
        ListeCle = MonDico.Keys
        ListeElement = MonDico.Items
 
        ' Tri par ordre alphabétique dans la variable tableau
        '----------------------------------------------------
        For i = 0 To MonDico.Count - 2
            For j = i + 1 To MonDico.Count - 1
                If ListeElement(i) > ListeElement(j) Then
 
                    Tempo1 = ListeCle(j)
                    Tempo2 = ListeElement(j)
 
                    ListeElement(j) = ListeElement(i)
                    ListeCle(j) = ListeCle(i)
 
                    ListeCle(i) = Tempo1
                    ListeElement(i) = Tempo2
 
                End If
            Next j
        Next i
 
        ' Initialisation et remplissage de la matrice
        '--------------------------------------------
 
        ReDim MaMatrice(UBound(ListeCle), 1)
        For i = LBound(ListeCle, 1) To UBound(ListeCle, 1)
            MaMatrice(i, 0) = ListeCle(i)
        Next i
 
        ' Cumul des produits colonne 1 * colonne 2 pour chaque référence
        '---------------------------------------------------------------
        For i = LBound(MaMatrice, 1) To UBound(MaMatrice, 1)
            For Each C In .Range(.Cells(1, 14), .Cells(DerniereLigne, 14))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 14) * (C.Offset(0, 9 - 14) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 15), .Cells(DerniereLigne, 15))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 15) * (C.Offset(0, 9 - 15) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 16), .Cells(DerniereLigne, 16))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 16) * (C.Offset(0, 10 - 16) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 17), .Cells(DerniereLigne, 17))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 17) * (C.Offset(0, 10 - 17) + 50)) / 1000
 
            Next C
 
        Next i
 
    End With
 
 
 
    Set MonDico = Nothing
 
End Sub
 
Sub RestituerLaMatrice(ByVal FeuilleCible As Worksheet)
 
    Dim DerniereLigneCible As Long, MonItem As Long
    Dim AireCible As Range, CelluleCible As Range
    Dim ReferenceTrouvee As Boolean
 
    With FeuilleCible
 
        DerniereLigneCible = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set AireCible = .Range(.Cells(1, 1), .Cells(DerniereLigneCible, 1))
 
        For MonItem = LBound(MaMatrice, 1) To UBound(MaMatrice, 1)
            ReferenceTrouvee = False
            For Each CelluleCible In AireCible
                If CelluleCible = MaMatrice(MonItem, 0) Then
                    CelluleCible.Offset(0, 1) = CelluleCible.Offset(0, 1) + MaMatrice(MonItem, 1)
                    ReferenceTrouvee = True
                End If
            Next CelluleCible
            If ReferenceTrouvee = False Then
                .Cells(DerniereLigneCible + 1, 1) = MaMatrice(MonItem, 0)
                .Cells(DerniereLigneCible + 1, 2) = MaMatrice(MonItem, 1)
                DerniereLigneCible = DerniereLigneCible + 1
            End If
        Next MonItem
 
        Set AireCible = Nothing
 
    End With
 
End Sub

J'espere avoir été assez clair et que quelqu'un pourra me donner un axe de recherche pour modifier le code, car je pense qu'il va faloir modifier certaine boucle mais je suis un peu perdu.

Merci d'avance

**mjpmjp** · 19/01/2018, 12h45

bonjour,
dans ton code , il y a une sub :
Sub Extraction_Code(ByVal FeuilleSource As Worksheet)
qui traite à " l'unité " ton problème qui était " global "
avec dans la sub :
Sub ExtractionCodeSurPlusieursOnglets()
qui utilise une boucle " globale " :

Code :

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

1
2
3
 
 For i = 7 To ThisWorkbook.Worksheets.Count
 Next

@+JP

**zoumzoum59** · 19/01/2018, 14h19

Bonjour et merci de me répondre mjpmjp.

Donc si j'arrive a te suivre,je devrais faire quelque chose du genre:

Modifier Sub ExtractionCodeSurPlusieursOnglets() en Sub ExtractionCodeSurUnSeulOnglet()

Puis

Code :

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

1
2
3
4
5
6

For i = 7 To ThisWorkbook.Worksheets.Count
Call ExtractionCodeSurUnSeulOnglet
Call RestituerLaMatrice
Decaler de une colonne
Next

**zoumzoum59** · 19/01/2018, 14h31

Bonjour Menhir,

Excuse moi pour la confusion que j'ai mis en mettant ce code Déja la ligne:

Code :

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

1
2
aze = ActiveWorkbook.Sheets(Sheets(i).Name).Range("N5:Q6500").Value

Devrait être effacé je l'avais mis pour faire des test et je ne l'ai pas effacé.

Ensuite oui le code désigne le même classeur et n'étant pas un pro, je ne me suis pas aperçu que mon manque de rigueur amenait une confusion. Re

Revoici le code sans cette ligne.

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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
Public MaMatrice() As Variant
 
Sub ExtractionCodeSurPlusieursOnglets()
 
    Dim ShCible As Worksheet
    Dim ListeDesOngletsATraiter As Variant
    Dim k As Integer
    Dim i As Integer, j As Integer, l As Integer, Tab_Feuil(), Liste()
 
 
 
    For i = 7 To ThisWorkbook.Worksheets.Count
 
 
 
        If Sheets(i).Visible And Application.CountA(ActiveWorkbook.Sheets(Sheets(i).Name).Range("N5:Q6500")) <> 0 Then
            ReDim Preserve Tab_Feuil(j)
            Set Tab_Feuil(j) = Sheets(Sheets(i).Name)      '<----- ligne complétée
            j = j + 1
        End If
 
    Next
    Dim lNumElements As Long
 
    lNumElements = UBound(Tab_Feuil) - LBound(Tab_Feuil) + 1
    l = lNumElements - 1
 
 
    Set ShCible = Sheets("Total Chant")
    With ShCible
        .Range(.Cells(1, 1), .Cells(.Rows.Count, 2)).ClearContents
    End With
    ListeDesOngletsATraiter = Tab_Feuil
 
    For k = 0 To l
 
        Extraction_Code ListeDesOngletsATraiter(k)
        RestituerLaMatrice ShCible
 
    Next k
    ' Tri de l'onglet cible....
    Set ShCible = Nothing
 
End Sub
 
Sub Extraction_Code(ByVal FeuilleSource As Worksheet)
 
    Dim MonDico As Object
    Dim C As Range
    Dim DerniereLigne As Long
 
    Dim ListeCle As Variant
    Dim ListeElement As Variant
    Dim i As Integer
    Dim j As Integer
    Dim Tempo1, Tempo2
 
    Set MonDico = CreateObject("Scripting.Dictionary")
 
    With FeuilleSource
        DerniereLigne = .Cells(.Rows.Count, 5).End(xlUp).Row  ' Colonne à adapter
        For Each C In .Range(.Cells(5, 14), .Cells(DerniereLigne, 17))
            If Not MonDico.Exists(C.Value) And C.Value <> "" Then MonDico.Add C.Value, C.Value
        Next C
        'Stop
        ListeCle = MonDico.Keys
        ListeElement = MonDico.Items
 
        ' Tri par ordre alphabétique dans la variable tableau
        '----------------------------------------------------
        For i = 0 To MonDico.Count - 2
            For j = i + 1 To MonDico.Count - 1
                If ListeElement(i) > ListeElement(j) Then
 
                    Tempo1 = ListeCle(j)
                    Tempo2 = ListeElement(j)
 
                    ListeElement(j) = ListeElement(i)
                    ListeCle(j) = ListeCle(i)
 
                    ListeCle(i) = Tempo1
                    ListeElement(i) = Tempo2
 
                End If
            Next j
        Next i
 
        ' Initialisation et remplissage de la matrice
        '--------------------------------------------
 
        ReDim MaMatrice(UBound(ListeCle), 1)
        For i = LBound(ListeCle, 1) To UBound(ListeCle, 1)
            MaMatrice(i, 0) = ListeCle(i)
        Next i
 
        ' Cumul des produits colonne 1 * colonne 2 pour chaque référence
        '---------------------------------------------------------------
        For i = LBound(MaMatrice, 1) To UBound(MaMatrice, 1)
            For Each C In .Range(.Cells(1, 14), .Cells(DerniereLigne, 14))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 14) * (C.Offset(0, 9 - 14) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 15), .Cells(DerniereLigne, 15))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 15) * (C.Offset(0, 9 - 15) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 16), .Cells(DerniereLigne, 16))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 16) * (C.Offset(0, 10 - 16) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 17), .Cells(DerniereLigne, 17))
                If C = MaMatrice(i, 0) Then MaMatrice(i, 1) = MaMatrice(i, 1) + (C.Offset(0, 8 - 17) * (C.Offset(0, 10 - 17) + 50)) / 1000
 
            Next C
 
        Next i
 
    End With
 
 
 
    Set MonDico = Nothing
 
End Sub
 
Sub RestituerLaMatrice(ByVal FeuilleCible As Worksheet)
 
    Dim DerniereLigneCible As Long, MonItem As Long
    Dim AireCible As Range, CelluleCible As Range
    Dim ReferenceTrouvee As Boolean
 
    With FeuilleCible
 
        DerniereLigneCible = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set AireCible = .Range(.Cells(1, 1), .Cells(DerniereLigneCible, 1))
 
        For MonItem = LBound(MaMatrice, 1) To UBound(MaMatrice, 1)
            ReferenceTrouvee = False
            For Each CelluleCible In AireCible
                If CelluleCible = MaMatrice(MonItem, 0) Then
                    CelluleCible.Offset(0, 1) = CelluleCible.Offset(0, 1) + MaMatrice(MonItem, 1)
                    ReferenceTrouvee = True
                End If
            Next CelluleCible
            If ReferenceTrouvee = False Then
                .Cells(DerniereLigneCible + 1, 1) = MaMatrice(MonItem, 0)
                .Cells(DerniereLigneCible + 1, 2) = MaMatrice(MonItem, 1)
                DerniereLigneCible = DerniereLigneCible + 1
            End If
        Next MonItem
 
        Set AireCible = Nothing
 
    End With
 
End Sub

**zoumzoum59** · 22/01/2018, 19h22

Bonsoir a tous,

Après quelques jours de travail

, pas en continu certes, je suis arrivé au résultat attendu

.

Nom : Résultat final.PNG
Affichages : 142
Taille : 24,2 Ko

Par contre je ne suis pas sur que mon code soit hyper clean

, c'est pour cela que je reposte mon code final pour le proposer à la relecture pour m'indiquer les points qui serait à modifier.

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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
Dim i As Integer
Dim DécalColonne As Integer
Dim Compteur As Integer
Public MaMatrice() As Variant
Dim ShCible As Worksheet
 
 
Sub ExtractionCodeSurPlusieursOnglets()
 
    Compteur = 1
    DécalColonne = 1
 
    For i = 7 To ThisWorkbook.Worksheets.Count
        Call ExtractionCodeSurUnOnglet
    Next
 
End Sub
 
Sub ExtractionCodeSurUnOnglet()
 
 
    Dim ListeDesOngletsATraiter As Variant
    Dim k As Integer
    Dim j As Integer, l As Integer, Tab_Feuil(), Liste()
 
 
 
 
    If Sheets(i).Visible Then
        ReDim Preserve Tab_Feuil(j)
        Set Tab_Feuil(j) = Sheets(i)      '<----- ligne complétée
        j = j + 1
 
    End If
 
 
    Dim lNumElements As Long
 
    lNumElements = UBound(Tab_Feuil) - LBound(Tab_Feuil) + 1
 
    l = lNumElements - 1
 
    Set ShCible = Sheets("Total Chant")
    If Compteur = 1 Then
 
        With ShCible
            .Range(.Cells(1, 1), .Cells(.Rows.Count, 20)).ClearContents
        End With
    End If
    Range("A4").Value = "Chants"
    Range("A5").Value = " "
    Compteur = Compteur + 1
    If Application.CountA(Sheets(i).Range("N5:Q6500")) <> 0 Then
        ListeDesOngletsATraiter = Tab_Feuil
 
        For k = 0 To l
 
            Extraction_Code ListeDesOngletsATraiter(k)
            RestituerLaMatrice ShCible
 
        Next k
 
    End If
    ' Tri de l'onglet cible....
    Set ShCible = Nothing
 
End Sub
 
Sub Extraction_Code(ByVal FeuilleSource As Worksheet)
 
    Dim MonDico As Object
    Dim C As Range
    Dim DerniereLigne As Long
 
    Dim ListeCle As Variant
    Dim ListeElement As Variant
    Dim m As Integer
    Dim j As Integer
    Dim Tempo1, Tempo2
 
    Set MonDico = CreateObject("Scripting.Dictionary")
 
    With FeuilleSource
        DerniereLigne = .Cells(.Rows.Count, 5).End(xlUp).Row  ' Colonne à adapter
        For Each C In .Range(.Cells(5, 14), .Cells(DerniereLigne, 17))
            If Not MonDico.Exists(C.Value) And C.Value <> "" Then MonDico.Add C.Value, C.Value
        Next C
 
        ListeCle = MonDico.Keys
        ListeElement = MonDico.Items
 
        ' Tri par ordre alphabétique dans la variable tableau
        '----------------------------------------------------
        For m = 0 To MonDico.Count - 2
            For j = m + 1 To MonDico.Count - 1
                If ListeElement(m) > ListeElement(j) Then
 
                    Tempo1 = ListeCle(j)
                    Tempo2 = ListeElement(j)
 
                    ListeElement(j) = ListeElement(m)
                    ListeCle(j) = ListeCle(m)
 
                    ListeCle(m) = Tempo1
                    ListeElement(m) = Tempo2
 
                End If
            Next j
 
        Next m
 
        ' Initialisation et remplissage de la matrice
        '--------------------------------------------
 
        ReDim MaMatrice(UBound(ListeCle), 1)
        For m = LBound(ListeCle, 1) To UBound(ListeCle, 1)
            MaMatrice(m, 0) = ListeCle(m)
        Next m
 
        ' Cumul des produits colonne 1 * colonne 2 pour chaque référence
        '---------------------------------------------------------------
        For m = LBound(MaMatrice, 1) To UBound(MaMatrice, 1)
            For Each C In .Range(.Cells(1, 14), .Cells(DerniereLigne, 14))
                If C = MaMatrice(m, 0) Then MaMatrice(m, 1) = MaMatrice(m, 1) + (C.Offset(0, 8 - 14) * (C.Offset(0, 9 - 14) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 15), .Cells(DerniereLigne, 15))
                If C = MaMatrice(m, 0) Then MaMatrice(m, 1) = MaMatrice(m, 1) + (C.Offset(0, 8 - 15) * (C.Offset(0, 9 - 15) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 16), .Cells(DerniereLigne, 16))
                If C = MaMatrice(m, 0) Then MaMatrice(m, 1) = MaMatrice(m, 1) + (C.Offset(0, 8 - 16) * (C.Offset(0, 10 - 16) + 50)) / 1000
            Next C
 
            For Each C In .Range(.Cells(1, 17), .Cells(DerniereLigne, 17))
                If C = MaMatrice(m, 0) Then MaMatrice(m, 1) = MaMatrice(m, 1) + (C.Offset(0, 8 - 17) * (C.Offset(0, 10 - 17) + 50)) / 1000
 
            Next C
        Next m
 
    End With
 
    Sheets("Total Chant").Cells(4, DécalColonne + 1) = FeuilleSource.Name
 
    Set MonDico = Nothing
 
End Sub
 
Sub RestituerLaMatrice(ByVal FeuilleCible As Worksheet)
 
    Dim DerniereLigneCible As Long, MonItem As Long
    Dim AireCible As Range, CelluleCible As Range
    Dim ReferenceTrouvee As Boolean
 
 
 
 
    With FeuilleCible
 
        DerniereLigneCible = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set AireCible = .Range(.Cells(1, 1), .Cells(DerniereLigneCible, 1))
 
        For MonItem = LBound(MaMatrice, 1) To UBound(MaMatrice, 1)
            ReferenceTrouvee = False
            For Each CelluleCible In AireCible
 
                If CelluleCible = MaMatrice(MonItem, 0) Then
                    CelluleCible.Offset(0, DécalColonne) = CelluleCible.Offset(0, DécalColonne) + MaMatrice(MonItem, 1)
 
                    ReferenceTrouvee = True
                End If
            Next CelluleCible
            If ReferenceTrouvee = False Then
                .Cells(DerniereLigneCible + 1, 1) = MaMatrice(MonItem, 0)
                .Cells(DerniereLigneCible + 1, DécalColonne + 1) = MaMatrice(MonItem, 1)
 
                DerniereLigneCible = DerniereLigneCible + 1
            End If
        Next MonItem
 
        Set AireCible = Nothing
 
    End With
    DécalColonne = DécalColonne + 1
End Sub

Merci d'avance

**Marc-L** · 23/01/2018, 09h47

Bonjour,

comment sont alimentées la colonne A et la ligne 4 ?

Sinon avec le B-A-BA d'Excel, de simples formules de calculs niveau débutant, à peine 20 lignes de codes sont nécessaires !
Voire même un code est inutile …

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**Menhir** · 19/01/2018, 14h19

Ca c'est étrange :

Code :

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

1
2
    For i = 7 To ThisWorkbook.Worksheets.Count
    aze = ActiveWorkbook.Sheets(Sheets(i).Name).Range("N5:Q6500").Value

Déjà, ActiveWorkbook.Sheets(Sheets(i).Name) peut s'écrire plus simplement Sheets(i).

Ensuite, il est étrange que tu comptes le nombre d'onglets dans ThisWorkbook et que tu appliques l'indice aux onglets de ActiveWorkbook (qui est le parent de ton Sheets(i) ).
A moins que ThisWorkbook et ActiveWorkbook ne soient qu'un seul et même fichier. Mais dans ce cas, je ne vois pas pourquoi tu entretiens la confusion dans ton code en utilisant deux dénominations différentes.

Modification de code dû a un besoin different

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager