[E-07] Rechercher une valeur dans une colonne (c) et sélectionner colonne (E à K)

**rvtoulon** · 09/03/2009, 16h56

Bonjour, j'ai un tableau excel qui se nomme "Bd" qui prends ces données dans d'autres tableaux sur d'autres feuilles du même classeur dans lequel figure divers éléments:
voir le fichier .xls joint

Dans mon code j'ouvre les fichiers ou je souhaite copier les données, je filtre le tableau "Bd" afin d'avoir uniquement les valeurs Réf: PP (colonne D). Ensuite, ce que j'aimerais faire c'est une boucle qui en fonction du Nom (colonne C), par exemple :"moi", sélectionne la plage qui correspond aux Colonnes E à K et ceci pour chaque ligne qui correspond au nom "moi", de copier cette plage et la coller dans un autre classeur.
j'ai mis en place une macro (voir ci dessous) manuellement qui fonctionne mais si dans mes tableaux sources j'insère d'autres lignes, cela modifie mon tableau "Bd" et m'oblige à rectifier manuellement chq plage de la macro. je voudrais donc automatiser ces opérations, j'espère avoir été clair.
Seulement je suis débutant en VBA et je ne maitrise pas encore les instructions for ou if.
J'utilise Excel 2007
merci de votre aide A+++

voici le code:

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
Sub ENVOYERVERS()
'
' ouvrirfichier Macro
'
 
'
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\Rv\Bureau\fpp.xlsx"
     Workbooks.Open Filename:= _
        "C:\Documents and Settings\RV\Bureau\SsdPP.xlsx"
 
    ActiveWorkbook.Windows.Arrange ArrangeStyle:=xlHorizontal
    Windows.Arrange ArrangeStyle:=xlHorizontal
 
 
' ENVOYERVERS Macro
'
 
    Windows("dabeta.xlsm").Activate
 
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=3, Criteria1:="PP"
    ActiveWorkbook.Worksheets("Bd").ListObjects("Bd").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Bd").ListObjects("Bd").Sort.SortFields.Add Key:= _
        Range("Bd[[#All],[Noms]]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Bd").ListObjects("Bd").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'Je sélectionne cette plage en visualisant le tableau sur la feuille. le but de ma demande est d'automatiser cette sélection !!!!!   
 
Range("E6:K126").Select
    Selection.Copy
    Windows("fpp.xlsx").Activate
    Sheets("H").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G6:G126").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("SsdPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("B3").Select
    ActiveSheet.Paste
 
 
    Windows("dabeta.xlsm").Activate
    Range("E127:K247").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("fpp.xlsx").Activate
    Sheets("J").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G127:G247").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("SsdPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("C3").Select
    ActiveSheet.Paste
 
   ' JE REPETE LE CODE CI DESSUS UNE DIZAINE DE FOIS
 
    Windows("dabeta.xlsm").Activate
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=3
 
    Range("B4").Select
 
 
End Sub

**NEC14** · 10/03/2009, 08h08

Bonjour,

Dans tes lignes similaires à celle-ci, essaie d'écrire comme ça, de cette façon il n'y a pas de limite dans ta colonne.

Code :

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

1
2
3
Range("G6:G126").Select
Range("G6:G").Select

**rvtoulon** · 10/03/2009, 08h19

bjr NEC14,
ok je vais essayer, merci.
non ça ne fonctionne pas j'ai une erreur du genre "erreur 1004".

**rvtoulon** · 10/03/2009, 08h47

en fait ce que je souhaite c'est que la sélection ci dessous est faite manuellement. c'est-à-dire, que lorsque mon tableau est filtré en fonction du nom qui se trouve dans la colonne C, se nom se repète plusieurs fois, je sélectionne manuellement les plages qui correspondent à ce nom. comment le faire automatiquement?

Code :

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

Range("E6:K126").Select

Je répète cette opération pour chaque nom différent de ma colonne C.

**aalex_38** · 10/03/2009, 11h03

Bonjour,

Pour selectionner les lignes qui correspondent à un critère tu peux utiliser la commande AutoFilter ensuite pour ne recopier que ces lignes filtrées :

Code :

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

Worksheets("NomDeMaFeuille").Cells.SpecialCells(xlCellTypeVisible).Copy

Nb: les activate et select sont rarement utiles en VBA

**rvtoulon** · 10/03/2009, 13h40

bonjour, aalex_38,
ta ligne fonctionne si je veux copier la ligne entière or je fais un filtre sur une colonne disons C et dans cette colonne j'ai plusieurs noms qui se répètent je voudrais en fonction d'un nom de cette colonne sélectionner uniquement les éléments qui se trouvent dans une plage qui va de la colonne E à K pour ce nom.

**aalex_38** · 10/03/2009, 17h53

Dans ce cas soit tu fais une boucle avec un FIND

Tu type

Code :

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

1
2
3
4
5
6
7
For Each MaCellule In MaPlage
'...
With Columns("D:D")
        Set cell = .Find(What:=MaRecherche, LookIn:=xlValues, LookAt:=xlPart)
End With
'=> cell.row te donnes le numéro de ligne
Next

Soit tu utilises Autofilter , un exemple avec l'enregistreur de macro a adapter :

Code :

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

1
2
3
4
Range("$A$1:$R$9995").AutoFilter Field:=16, Criteria1:="204"
    Range("E277:J9902").Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste

**rvtoulon** · 10/03/2009, 20h15

Re Aalex_38,
Merci de te pencher sur mon problème. J'ai essayer de modifier ma macro pour arriver aux résultats que je souhaite. Elle fonctionne, mais il y a certainement plus facile que ce que j'ai écrit.
tout d'abord je commence par ouvrir les classeurs qui recevront les données copiées. Ensuite je séléctionne le classeur et la feuille qui contiennent les données, je filtre mes données que je recopie sur une feuil sachant que chaque ligne recopier représente un mois de l'année donc toute une année pour une personne. lorsque tout est copier je sélectionne la plage qui m'intéresse (elle correspond à une année de travail)et je la copie dans les autres classeurs. voici mon code comme je le disais il doit certainement y avoir plus simple. si vous pouvez m'aider à le simplifier ce serait top Merci.

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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
Sub CopierdonnéesPP()
'
' 
'
 
 
'Ouvrir les classeurs pour copie des informations
    Workbooks.Open Filename:= _
        "C:\Projet\fpp.xlsx"
     Workbooks.Open Filename:= _
        "C:\Projet\SdsPP.xlsx"
 
 'Les ranger en cascade horizontal
 
    ActiveWorkbook.Windows.Arrange ArrangeStyle:=xlHorizontal
    Windows.Arrange ArrangeStyle:=xlHorizontal
 
 
'Je copie les données sur la feuil3
 
 Windows("dabeta.xlsm").Activate
 
 Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=3, Criteria1:="PP"
 
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "JE"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B2").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "TU"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B15").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "IL"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B28").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "NOUS"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B41").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "VOUS"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B54").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "ILS"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B67").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "MOI"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B80").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "TOI"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B93").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "LUI"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B106").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "ELLE"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B119").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2, Criteria1:= _
        "EUX"
 
Range("bd").Cells.SpecialCells(xlCellTypeVisible).Copy
Sheets("Feuil3").Select
Range("B132").Select
ActiveCell.PasteSpecial xlPasteValues
 
Sheets("Bd").Select
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=3
    ActiveSheet.ListObjects("Bd").Range.AutoFilter Field:=2
Range("B4").Select
 
Sheets("Feuil3").Select
 
'je sélectionne et copie les données pour les coller dans des classeurs différents
'
 
Range("E2:K13").Copy
    Windows("fpp.xlsx").Activate
    Sheets("JE").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G2:G13").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("B3").Select
    ActiveSheet.Paste
 
 
    Windows("dabeta.xlsm").Activate
    Range("E15:K26").Copy
    Windows("fpp.xlsx").Activate
    Sheets("tu").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G15:G26").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("C3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E28:K39").Copy
    Windows("fpp.xlsx").Activate
    Sheets("IL").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G28:G39").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("D3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E41:K52").Copy
    Windows("fpp.xlsx").Activate
    Sheets("NOUS").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G41:G52").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("E3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E54:K65").Copy
    Windows("fpp.xlsx").Activate
    Sheets("VOUS").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G54:G65").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("F3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E67:K78").Copy
    Windows("fpp.xlsx").Activate
    Sheets("ILS").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G67:G78").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("G3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E80:K91").Copy
    Windows("fpp.xlsx").Activate
    Sheets("MOI").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G80:G91").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("H3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E93:K104").Copy
    Windows("fpp.xlsx").Activate
    Sheets("TOI").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G93:G104").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("I3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E106:K117").Copy
    Windows("fpp.xlsx").Activate
    Sheets("LUI").Select
    Range("B10").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G106:G117").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("J7").Select
    ActiveSheet.Paste
 
 
    Windows("dabeta.xlsm").Activate
    Range("E119:K130").Copy
    Windows("fpp.xlsx").Activate
    Sheets("ELLE").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G119:G130").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("K3").Select
    ActiveSheet.Paste
 
    Windows("dabeta.xlsm").Activate
    Range("E132:K143").Copy
    Windows("fpp.xlsx").Activate
    Sheets("EUX").Select
    Range("B6").Select
    ActiveSheet.Paste
    Range("D3").Select
    Windows("dabeta.xlsm").Activate
    Range("G132:G143").Copy
    Windows("SdsPP.xlsx").Activate
    Sheets("AdPP").Select
    Range("L3").Select
    ActiveSheet.Paste
    Range("D20").Select
 
 
    Windows("dabeta.xlsm").Activate
    Columns("A:L").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
 
End Sub

qu'en pensez-vous?
aalex_38,je vais essayer d'utiliser le code que tu m'as donnés encore merci

**aalex_38** · 11/03/2009, 09h24

Re,

Optimiser le code n'est pas la chose la plus aisée si ça fonctionne c'est l'essentiel !

Une seule chose me choque dans le code ce sont les select et activate qui ne servent pratiquement jamais à rien dans du code VBA, les selections sont faites dans l'enregistreur de macro qui fait exactement ce que l'utilisateur fait, c'est à dire sélectionner une cellule, copier sa valeur...
L'enregistreur est très utile pour trouver les commandes mais le code n'est pas propre et il est ralentit par des selections inutiles.
Attention aussi à activecell et activesheet qui demandent à être sur que la cellule ou la feuille active est bien celle que l'on croit.

Par exemple au lieu de

Code :

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

1
2
3
Sheets("Feuil3").Select
Range("B93").Select
ActiveCell.PasteSpecial xlPasteValues

Tu peux coder

Code :

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

Sheets("Feuil3").Range("B93").PasteSpecial xlPasteValues

**rvtoulon** · 11/03/2009, 13h29

Merci Aalex_38,
j'ai commencé à épurer un peu le code en supprimant quelques select. je vais adapter la ligne que tu m'as donnée.
C'est vrai que je me suis beaucoup servit de l'enregistreur de macro, ce qui m'a permis de comprendre un peu mieux le code. Pour répondre à ta question, j'utilise souvent .Activate pour passer d'une fenêtre d'un classeur ouvert à un autre afin de copier mes données au fur et à mesure. Si tu vois un moyen de faire autrement je suis preneur.

Merci de t'être penché sur ma question.

**aalex_38** · 11/03/2009, 16h54

Regardes la méthode copy dans l'aide en ligne VBA, tu verras que tu peux utiliser le paramètre destination.

Tu peux aussi faire comme ça :

Code :

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

1
2
3
4
5
6
7
Dim FA As Worksheet, FE As Worksheet ' Déclare des feuilles
 Set FA = Worksheets("NomDeLaFeuilleA") 'Instancie  
 Set FE = Worksheets("NomDeLaFeuilleE") 
 
'Recopie des zones filtrées dans le nouvel onglet
        FA.Cells.SpecialCells(xlCellTypeVisible).Copy
        FE.Paste

**aalex_38** · 11/03/2009, 17h29

Code :

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

FA.Cells.SpecialCells(xlCellTypeVisible).Copy

est un exemple pour ne recopier que les cellules visibles plus généralement :

Code :

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

FA.Range("A1:E29").copy Destination:=FE.Range("B2:F30").Paste

**rvtoulon** · 12/03/2009, 18h15

Merci alex pour ton aide et tes conseils éclairés.

A+

**aalex_38** · 12/03/2009, 18h30

Merci c'est sympa.

NB : Il y a bien plus éclairé que moi sur ce forum

[E-07] Rechercher une valeur dans une colonne (c) et sélectionner colonne (E à K)

Macros et VBA Excel

Discussions similaires

Partager

Partager