Mon code ne fonctionne pas correctement

**capi81** · 15/07/2014, 11h27

Salut le forum

J'ai un soucis avec le code ci-dessous.
En effet, il est sensé m'aider à faire la synthèse de plusieurs feuilles.
Je définis des critères de lignes à copier et lorsque la condition est vérifiée, la copier se réalise vers la feuille "SOURCE".
Je constate que la copie ne prend pas en compte tous les éléments notemment cette ligne:

Code :

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

Val_possibles(12) = "253900"

La ligne portant cette rubrique devait aussi être copié vers la feuille "SOURCE" mais la copie ne se fait pas.
Voici l'intégralité du code à apprécier:

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
Sub Execution(repertoire_source As String, ByVal Cible As Worksheet)
 
Dim i As Long
Dim Max_ligne As Long
Dim last_source_line As Long
 
Dim B, Str As String
Dim Val_possibles(13) As Variant
Dim Match As Boolean
Dim Lignes_a_suppr As Collection
Dim L As Variant
 
Dim source As Worksheet
 
'Import du fichier
Call Copie(Cible, repertoire_source)
'Split en colonnes
Call Split(Cible)
 
Set source = Sheets("Source")
'Suppression des colonnes B,E,F,I,J,K
Cible.Columns("k:k").Delete Shift:=xlToLeft
Cible.Columns("j:j").Delete Shift:=xlToLeft
Cible.Columns("i:i").Delete Shift:=xlToLeft
Cible.Columns("f:f").Delete Shift:=xlToLeft
Cible.Columns("e:e").Delete Shift:=xlToLeft
Cible.Columns("b:b").Delete Shift:=xlToLeft
 
'Suppression des lignes pour lesquelles la cellule B est de longueur inférieure à 6
'Les lignes sont d'abord stockées dans une collection, afin de ne pas perturber la boucle
'Puis tous les membres de la collection sont supprimés
Max_ligne = Cible.UsedRange.Rows.Count
Set Lignes_a_suppr = New Collection
 
For i = 1 To Max_ligne
    Str = Cible.Cells(i, 2).Value
    Str = Replace(Str, " ", "")
 
    If Len(Str) < 6 Or Str = "------" Then 'la condition 6 tirets n'est pas dans le cahier des charges mais elle m'a paru évidente
        Lignes_a_suppr.Add Cible.Cells(i, 2).EntireRow
    End If
Next i
For Each L In Lignes_a_suppr
    L.Delete
Next L
 
Set Lignes_a_suppr = Nothing
 
'Insertion d'une ligne
Cible.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
'Titres des colonnes
Cible.Cells(1, 1).Formula = "Code Agence"
Cible.Cells(1, 2).Formula = "RC"
Cible.Cells(1, 3).Formula = "Libellé"
Cible.Cells(1, 4).Formula = "Montant"
Cible.Cells(1, 5).Formula = "Nbre"
 
'Inscription du nom de la feuille en colonne A si b non vide, ou b rempli de blancs
For i = 2 To Max_ligne
    If Replace(Cible.Cells(i, 2).Value, " ", "") <> "" Then
        Cible.Cells(i, 1).Value = Cible.Name
    End If
Next i
 
 
'Suppression des .00 et des virgules
 
Cible.Range("D:E").Replace What:=".00", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
 
Cible.Range("D:E").Replace What:=",", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
 
 
'Copie des lignes correspondant à certains critères
 
last_source_line = source.Range("A65000").End(xlUp).Row
 
'Pour rajouter des valeurs à ressortir dans l'onglet source, ne pas oublier de redimensionner
'la taille du tableau dans les déclarations
Val_possibles(0) = "251125"
Val_possibles(1) = "251132"
Val_possibles(2) = "251134"
Val_possibles(3) = "251173"
Val_possibles(4) = "253110"
Val_possibles(5) = "253111"
Val_possibles(6) = "253115"
Val_possibles(7) = "253116"
Val_possibles(8) = "253118"
Val_possibles(9) = "253210"
Val_possibles(10) = "253216"
Val_possibles(11) = "253310"
Val_possibles(12) = "253900"
 
'Copie des lignes comprenant les valeurs énoncées dans le tableau Val_possibles
For i = 1 To Max_ligne
    Match = False
    For Each v In Val_possibles
        If v = Cible.Cells(i, 2).Value Then
            Match = True
            Exit For
        End If
    Next v
    If Match Then
        Cible.Cells(i, 2).EntireRow.Copy
        DoEvents
        source.Select
        source.Rows(last_source_line & ":" & last_source_line).Select
        source.Paste
        last_source_line = last_source_line + 1
    End If
Next i
 
End Sub

je reste à votre disposition pour des compléments d'informations

**Kimy_Ire** · 15/07/2014, 11h43

Bonjour capi81,

Alors je n'ai pas la solution à ton problème mais je te propose plusieurs pistes.

Tout d'abord tu définis Dim Val_possibles(13) As Variant et tu n'affectes pas la valeur Val_possibles(13). Il est a donc des choses à changer de ce côté.

Ensuite, au vu de ton code, je te dirais bien d'appliquer un Option Explicit en haut de ton code. Souvent les erreurs d’affectation sont liées à des erreurs de frappe.
Je ne crois pas en avoir détecté, cependant, ça t'aidera, je pense.

Enfin, je ne vois AUCUN intérêt d'appliquer un DoEvents pour ton cas.
J’imagine que tu as placer cette méthode pour accélérer ta macro.
Passe plutôt par ceci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub XXX
 
Application.Visible = False
Application.Calculation = xlCalculationManual
 
'code
 
Application.Calculation = xlCalculationAutomatic
Application.Visible = True
 
End Sub

En espérant que ces différents points te permettent de résoudre ton problème, je te laisse me te tenir au courant.

Cordialement,
Kimy

**capi81** · 15/07/2014, 12h26

Salut Kimy et le forum

Merci pour vos propositions.
Je viens de les appliquer mais y'a débogage sur la variable v qui n'est pas définie.
Comment la définir?

Code :

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

1
2
3
4
5
6
For Each v In Val_possibles
        If v = Cible.Cells(i, 2).Value Then
            Match = True
            Exit For
        End If
    Next v

Après votre réponse, je pourrai mieux tester et vous confirmer le résultat.

**Kimy_Ire** · 15/07/2014, 16h24

Ah... Ce n'est pas toi qui a codé la macro que tu as montré...

Teste simplement ceci :
- Oublie le "Option Explicit"
- Supprime le DoEvents.

Cordialement,
Kimy

**capi81** · 15/07/2014, 17h17

Ah... Ce n'est pas toi qui a codé la macro que tu as montré...

Non j'ai eu de l'aide d'une personne ressource dans ce forum que je remercie encore.
J'ai fais ce que vous avez dit mais le résultat est toujours le même.
N.B:j'ai oublié de vous donner une précision depuis le debus de post:
il y'a au moins 29 feuilles dans mon classeur et normalement dans chaque feuille la macro devrait copier les élements définis vers la feuille "SOURCE". Il copie tous les éléments définis à l'excption de cette partie du tableau mais par contre sur la dernière feuille, il la copie et la colle sur la feuille source.
Je ne sais pas pourquoi il ne le généralise pas pour les autres feuilles.
Je me suis poser la question de savoir pourquoi il n'arive pas à étendre le traitement sur les autres feuilles et se contente seulement de la dernière feuille?

Code :

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

Val_possibles(12) = "253900"

**Philippe Tulliez** · 15/07/2014, 18h11

Bonjour,

J'ai un soucis avec le code ci-dessous.
En effet, il est sensé m'aider à faire la synthèse de plusieurs feuilles.
Je définis des critères de lignes à copier et lorsque la condition est vérifiée, la copier se réalise vers la feuille "SOURCE"

S'il s'agit d'exporter des données d'une plage source vers une plage cible suivant des conditions, je te suggère l'utilisation du filtre élaboré d'excel (pratiquement une ligne de code en VBA). A lire Les filtres avancés ou élaborés dans Excel
Cependant je vois que tu utilises également la méthode REPLACE pour les séparateurs de décimal notamment et en plus une suppression de lignes.
Explique ce que tu cherches à faire.

**Kimy_Ire** · 15/07/2014, 18h36

capi81,

Pourrais-tu nous fournir un fichier exemple avec 3/4 onglets de données pour nous permettre de comprendre pourquoi ta condition For Each v In Val_possibles ne fonctionne pas avec Val_possibles(12) = "253900" ?

La communauté pourra d'avantage t'aider grace à cela.

Cordialement,
Kimy

**capi81** · 16/07/2014, 11h40

Salut Kimy, Phillipe et le forum

Ok pour ta proposition kimy.
Ci-joint le fichier. Pour raison de discrétion, j'ai effacé le contenu de la colonne C.
Phillipe je vous reviendrai si malgré le fichier joint, une solution ne se décante pas pour moi.
http://cjoint.com/?DGpsXc2vcbq
Il y'a 2 module dans le fichier et le traitement est un enchainement.
C'est le résultat d'après le traitement que j'ai joins car pour vous permettre de tout tester, il fallait que je joigne aussi les fichiers texte ce qui sera un peu "compliqué"(dernier recours).

Salut le forum

Merci à phillipe de prendre connaissance du lien ci-dessous pour voir le sujet initial que j'ai posté et qui permi de réaliser le code qui me pose un petit soucis. A travers ce lien, vous pourrez mieux apprécier mon besoin et voir comment le simplifier.
http://www.developpez.net/forums/d14...pte-situation/

Mon code ne fonctionne pas correctement

Macros et VBA Excel

Discussions similaires

Partager

Partager