importation de page web avec pagination

**elb56** · 18/01/2024, 12h54

Bonjour,
c'est mon premier post sur ce forum que je consulte régulièrement.

J'ai besoin d'aide pour un projet perso sur lequel je sèche totalement depuis plusieurs jours.
Le projet est tout simple: récupérer sur 1 site internet le calendrier d'épreuves sportives le plus rapidement et le plus proprement possible.
J'ai un code qui fonctionne, mais j'aimerais l'améliorer pour les raisons citées ci-dessus et peut-être, par la suite, aller un peu plus loin dans mon projet...

Je suis preneur de toutes les idées et techniques que vous pourrez me proposer.
Mon gros soucis, je ne sais pas comment gérer l'implémentation de la pagination de la page internet!

Voici mon code (long, lent et rébarbatif) mais qui fonctionne! j'ai tenté plusieurs techniques de simplification sans parvenir au résultat souhaité:

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
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
Sub importercalendrier()
 
Sheets("TEMP").Cells.Clear
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
    With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=10" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=9" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=8" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=7" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=6" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=5" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=4" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=3" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=2" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=1" _
        , Destination:=Sheets("TEMP").Range("$A$1"))
        .Name = "évènement"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
 
    Dim LastLig1 As Long
 
    LastLig = Sheets("CALENDRIER").Cells(Rows.Count, 1).End(xlUp).Row
    compteur = LastLig - 1
 
    For ligne = 101 To 212
 
        If Left(Sheets("TEMP").Cells(ligne, 1), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 1).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 1)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 1), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 1).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 1)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 2), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 2).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 2)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 2), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 2).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 2)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 1)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 1)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 3), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 3).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 3)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 3), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 3).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 3)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 3)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 4), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 4).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 4)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 4), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 4).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 4)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 4)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 5), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 5).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 5)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 5), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 5).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 5)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 5)
            End If
         If Left(Sheets("TEMP").Cells(ligne, 6), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 6).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 6)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 6), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 6).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 6)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 6)
            End If
         If Left(Sheets("TEMP").Cells(ligne, 7), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 7).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 7)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 7), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 7).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 7)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 7)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 8), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 8).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 8)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 8), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 8).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 8)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 8)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 9), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 9).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 9)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 9), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 9).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 9)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 9)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 10), 3) = "U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 10).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 10)
            End If
        If Left(Sheets("TEMP").Cells(ligne, 10), 8) = "U15, U17" Then
            compteur = compteur + 1
            Sheets("CALENDRIER").Cells(compteur + 1, 1) = Sheets("TEMP").Cells(ligne - 6, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 6) = Sheets("TEMP").Cells(ligne - 2, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 3) = Sheets("TEMP").Cells(ligne, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 4) = Sheets("TEMP").Cells(ligne - 4, 10).Hyperlinks(1).Address
            Sheets("CALENDRIER").Cells(compteur + 1, 5) = Sheets("TEMP").Cells(ligne - 8, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 2) = Sheets("TEMP").Cells(ligne - 4, 10)
            Sheets("CALENDRIER").Cells(compteur + 1, 7) = Sheets("TEMP").Cells(ligne + 2, 10)
            End If
     Next
 
Call Calendrier_DoublonetTri
Call clearTEMP
   Sheets("CALENDRIER").Select
End Sub
 
 
Sub Calendrier_DoublonetTri()
 
' supprimer les doublons de la feuille CALENDRIER et trier par date puis course
 
    Sheets("CALENDRIER").Select
    Range("A1:G801").Select
    ActiveSheet.Range("$A$1:$G$74").RemoveDuplicates Columns:=4, Header:=xlYes
    ActiveWorkbook.Worksheets("CALENDRIER").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CALENDRIER").Sort.SortFields.Add2 Key:=Range( _
        "E2:E74"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("CALENDRIER").Sort.SortFields.Add2 Key:=Range( _
        "F2:F74"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CALENDRIER").Sort
        .SetRange Range("A2:G74")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("CALENDRIER").Select
 
 
Application.Calculation = xlAutomatic
End Sub
 
Sub clearTEMP()
 
    Sheets("TEMP").Select
    Cells.Select
    Selection.ClearContents
 
 
End Sub

**jurassic pork** · 18/01/2024, 14h39

Hello,
je ne sais pas ce que tu cherches exactement à récupérer mais voici un code qui vient récupérer la date et les infos des différentes courses sur toutes les pages et qui les mets dans les colonnes A et B de la feuille qui se nomme Calendrier :

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
Sub RecupCalendrierCyclo()
Dim cheminWeb As Variant, cellDep As Range
Dim elems As Object, elemDate As Object, elemInfos As Object
Dim x As Integer, y As Integer, z As Integer
Dim xmlHttpRequest As Object, HtmlDoc As Object
Set xmlHttpRequest = CreateObject("MSXML2.XMLHTTP")
Set HtmlDoc = CreateObject("HTMLFile")
Set cellDep = Sheets("Calendrier").Range("A2")
z = 0
  For x = 1 To 16
        On Error GoTo ErrWeb
        cheminWeb = "https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=" & x
        ' Ouvrir une connexion à l'URL
        xmlHttpRequest.Open "GET", cheminWeb, False
        xmlHttpRequest.send
        On Error GoTo 0
        If xmlHttpRequest.Status = 200 Then
            ' Charger le contenu HTML de la page dans un objet HTML
                HtmlDoc.body.innerHTML = xmlHttpRequest.responseText
                Set elems = HtmlDoc.getElementsByClassName("card-course__inner")
                For y = 0 To elems.length - 1
                    Set elemDate = elems.Item(y).getElementsByClassName("card-course__date")
                    Set elemInfos = elems.Item(y).getElementsByClassName("card-course__infos")
                      Debug.Print elemDate.Item(0).innerText
                      Debug.Print elemInfos.Item(0).innerText
                      Debug.Print "=============================================="
                      cellDep.offset(z, 0).value = elemDate.Item(0).innerText
                      cellDep.offset(z, 1).value = elemInfos.Item(0).innerText
                     z = z + 1
                Next y
        End If
  Next x
 Set xmlHttpRequest = Nothing
 Set HtmlDoc = Nothing
 Set regex = Nothing
Exit Sub
ErrWeb:
MsgBox "Impossible de lancer la recherche Web "
End Sub

Ami calmant, J.P

**deedolith** · 18/01/2024, 14h59

Salut,

Commence par virer ces horribles Application.ScreenUpdating = False et Application.Calculation = xlManual, tant que tu es en mode développement, ça t'apporte plus d'emmerdes qu'autre chose. (d'autant que tu en as oublié la contrepartie).
L'optimisation des perfs, s'il y a lieu, c'est à la fin, après avoir mesuré les pertes.

Ensuite, pourquoi te faire chier à recréer les requêtes à chaque éxecution ?
Enregistre les, et contente toi de les rafraichir (ca fera du code plus propre).

Enfin, si tu recherches de la vitesse, ce ne sont pas des cellules ni des plages qu'il faut manipuler, mais leurs valeurs. Je m'explique:
La valeur d'une plage est convertible en un tableau 2D, et un tableau 2D est convertible en plage.
Exécuter un algorithme sur le tableau est autrement plus rapide qu'exécuter son équivalent sur une plage.
Par contre, on perd les formules, les types de donnée et en lisibilité du code ect ... ca demande beaucoup plus de rigueur et de discipline.

Exemple:

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
Public Sub Exemple()
    Dim Ws As Excel.Worksheet
    Set Ws = ThisWorkbook.Worksheets(1)
 
    Dim Rng As Excel.Range
    Set Rng = ThisWorkbook.Worksheets(1).Range("A1:X5000")
 
    Dim Data() As Variant
    Data = Rng.Value
 
    Dim Somme As Long
    Dim i As Long
    For i = LBound(Data, 1) to UBound(Data, 1)
        Dim j As Long
        For i = LBound(Data, 2) To UBound(Data, 2)
            Somme = Somme + Data(i, j)    '// Somme de tous les elements
            Data(i, j) = data(i, j) * 10          '// Multiplie l'element par 10
        Next
    Next
 
    Debug.Print Somme
        '// Resultats sur la feuille 2
    CopyArrayToRange Data, ThisWorkbook.Worksheets(2).Range("A1")
End Sub
 
Public Sub CopyArrayToRange(ByRef Data() As Variant, ByRef Cell As Excel.Range)
    Debug.Assert GetArrayDimensions(Data) = 2    '// Le tableau doit être 2D
    Debug.Assert Cell.Cells.Count = 1      '// Cell ne doit être qu'une seule cellule
 
    Dim Ws As Excel.Worksheet
    Set Ws = Cell.Parent
 
        '// Calcul de la taille de la plage recevant les données
        '// Doit correspondre a la taille du tableau
    Dim Rng As Excel.Range
    Set Rng = Ws.Range(Cell, Cell.Offset(RowOffset:=UBound(Data, 1), ColumnOffset:=UBound(Data, 2) - 1)
    Rng.Value = Data    '// Transfert des valeurs (tout d'un coup)
End Sub
 
Public Function GetArrayDimensions(ByRef Data() As Variant) As Long
On Error GoTo Error
    Dim Dimension As Long
 
    Dimension = 0
    Do While True
        Dimension = Dimension + 1
 
        Dim Bound As Long
        Bound = LBound(Data, Dimension)
    Loop
ErrorResume:
    GetArrayDimensions = Dimension
Exit Function
Error:
    Dimension = Dimension - 1
    GoTo ErrorResume
End Function

**Franc** · 18/01/2024, 15h39

Salut, voici ma suggestion, un peu plus compacte et lisible que la tienne (ce n'est pas une critique).

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
Sub importercalendrier_V2()
 
    Dim i As Integer
    Dim lastlig As Long
    Dim compteur As Long
    Dim ligne As Long
    Dim col As Long
 
    Sheets("TEMP").Cells.Clear
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
    For i = 1 To 10
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=" & i, Destination:=Sheets("TEMP").Range("$A$1"))
            .Name = "évènement"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    Next i
 
    lastlig = Sheets("CALENDRIER").Cells(Rows.Count, 1).End(xlUp).Row
    compteur = lastlig - 1
 
    For ligne = 101 To 212
        For col = 1 To 10
            If Left(Sheets("TEMP").Cells(ligne, col), 3) = "U17" Or Left(Sheets("TEMP").Cells(ligne, col), 8) = "U15, U17" Then
                compteur = compteur + 1
                With Sheets("CALENDRIER").Cells(compteur + 1, 1)
                    .Value = Sheets("TEMP").Cells(ligne - 6, col).Value
                    .Offset(0, 5).Value = Sheets("TEMP").Cells(ligne - 2, col).Value
                    .Offset(0, 2).Value = Sheets("TEMP").Cells(ligne, col).Value
                    .Offset(0, 3).Value = Sheets("TEMP").Cells(ligne - 4, col).Hyperlinks(1).Address
                    .Offset(0, 4).Value = Sheets("TEMP").Cells(ligne - 8, col).Value
                    .Offset(0, 1).Value = Sheets("TEMP").Cells(ligne - 4, col).Value
                    .Offset(0, 6).Value = Sheets("TEMP").Cells(ligne + 2, col).Value
                End With
            End If
        Next col
    Next ligne
 
    Call Calendrier_DoublonetTri
    Call clearTEMP
    Sheets("CALENDRIER").Activate
 
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
 
End Sub

J'ai un peu allégé tes 2 autres macros:

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
Sub Calendrier_DoublonetTri()
    ' supprimer les doublons de la feuille CALENDRIER et trier par date puis course
    With Sheets("CALENDRIER")
        .Range("$A$1:$G$801").RemoveDuplicates Columns:=4, Header:=xlYes
        With .Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("E:E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range("F:F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A:G")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
    End With
End Sub

Code :

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

1
2
3
Sub clearTEMP()
    Sheets("TEMP").Cells.ClearContents
End Sub

**elb56** · 18/01/2024, 23h26

Un grand merci à tous les 3!!!

Je n'ai pas donné assez de détail sur le résultat souhaité et les conditions d'importations.

1- Voici le résultat attendu:
Discipline Niveau Catégorie URL Date Course Région
Route Régional U17 www.truc 25/12/2023 GP DE TRUC occitanie
Cyclocross National U15, U17 www.machin 01/01/2024 TROPHEE MACHIN normandie

2- Sur le site internet, La liste sera actualisée régulièrement en cours de saison et les épreuves supprimées une fois la date passé. je devrai lancé la macro à minima 1 fois par semaine pour importer la liste de toutes les épreuves sans doublon.

j'ai essayé de comprendre et d'adapter vos différentes méthodes

deedolith, le code le plus poussé que j'ai partiellement compris sans réussir à l'adapter à mon attente. Niveau méthode d'optimisation et de rapidité c'est le top! Bien au delà de mon modeste niveau de bricoleur VBA, j'ai dû abandonner.

jurassic pork, code plus compréhensible pour moi que j'ai réussi à adapter (sauf l'url : href) le soucis est que je dois ajouter un peu de code pour ne garder que les courses de catégorie U15, U17 et U17. je me suis arrêté à ce stade, mais pour obtenir le résultat souhaité en ajoutant les nouvelles courses sans faire de doublon il faut encore bidouiller un peu! au final le code devient lourd et aussi lent que celui que j'ai donné en exemple. Je garde la méthode sous le coude quand même car la logique me plait et j'aimerais l'approfondir...

Franc, l'optimisation que je tente d'obtenir depuis un moment, tout a fait dans mon raisonnement, servi sur un plateau en plus, fonctionne sans adaptation. Un grand merci, c'est la méthode que j'ai retenu pour l'instant! toutefois le délai d'execution reste assez important.

Encore un fois Merci à vous,
Avec des exemples concret comme les votre je ne peux que m'améliorer en VBA

**Franc** · 19/01/2024, 02h06

Salut, voici une version ou j'utilise un tableau en mémoire pour récupérer les données et les écrire sur la feuille "CALENDRIER". Chez moi, je passe de 8.67 secondes avec ma première macro à 7.5 secondes de traitement avec celle-ci. Le plus chronophage dans ce code (90% du temps) est la boucle for i = 1 to 10, qui lance les requêtes sur le web pour récupérer les données et donc le temps varie en fonction de la vitesse de ta connexion. Personnellement je ne connais pas de moyen d'accélérer cette partie du 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
Sub importercalendrier_V3()
 
    Dim i As Integer
    Dim lastlig As Long
    Dim compteur As Long
    Dim ligne As Long
    Dim col As Long
    Dim data() As Variant
 
    Sheets("TEMP").Cells.Clear
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
    For i = 1 To 10
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=" & i, Destination:=Sheets("TEMP").Range("$A$1"))
            .Name = "évènement"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    Next i
 
    lastlig = Sheets("CALENDRIER").Cells(Rows.Count, 1).End(xlUp).Row
    compteur = lastlig - 1
 
    data = Sheets("TEMP").Range("A101:J212").Value
 
    For ligne = 1 To UBound(data, 1)
        For col = 1 To UBound(data, 2)
            If Left(data(ligne, col), 3) = "U17" Or Left(data(ligne, col), 8) = "U15, U17" Then
                compteur = compteur + 1
                With Sheets("CALENDRIER").Cells(compteur + 1, 1)
                    .Value = data(ligne - 6, col)
                    .Offset(0, 5).Value = data(ligne - 2, col)
                    .Offset(0, 2).Value = data(ligne, col)
                    .Offset(0, 3).Value = Sheets("TEMP").Cells(ligne + 100 - 4, col).Hyperlinks(1).Address
                    .Offset(0, 4).Value = data(ligne - 8, col)
                    .Offset(0, 1).Value = data(ligne - 4, col)
                    .Offset(0, 6).Value = data(ligne + 2, col)
                End With
            End If
        Next col
    Next ligne
 
    Call Calendrier_DoublonetTri
    Call clearTEMP
    Sheets("CALENDRIER").Activate
 
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
 
End Sub

**jurassic pork** · 19/01/2024, 10h57

Hello,
suite aux remarques, voici une nouvelle version à tester (feuille CalendrierJp)

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
Sub RecupCalendrierCyclo()
Dim cheminWeb As Variant, cellDep As Range
Dim elem As Object, elems As Object
Dim UrlCourse As String, DateCourse As String
Dim Discipline As String, Niveau As String, Catégorie As String
Dim Course As String, Région As String
Dim x As Integer, y As Integer, z As Integer
Dim xmlHttpRequest As Object, HtmlDoc As Object, DicoUrl As Object
Set xmlHttpRequest = CreateObject("MSXML2.XMLHTTP")
Set HtmlDoc = CreateObject("HTMLFile")
Set DicoUrl = CreateObject("Scripting.Dictionary")
Set cellDep = Sheets("CalendrierJp").Range("A2")
z = 0
  For x = 1 To 100
        On Error GoTo ErrWeb
        cheminWeb = "https://velo.ffc.fr/calendrier/?_licence=u17&_pagination=" & x
        DicoUrl.RemoveAll
        ' Ouvrir une connexion à l'URL
        xmlHttpRequest.Open "GET", cheminWeb, False
        xmlHttpRequest.send
        On Error GoTo 0
        If xmlHttpRequest.Status = 200 Then
            ' Charger le contenu HTML de la page dans un objet HTML
                HtmlDoc.body.innerHTML = xmlHttpRequest.responseText
                Set elems = HtmlDoc.getElementsByClassName("card-course")
                If elems.length = 0 Then Exit For
                For Each elem In elems
                    UrlCourse = elem.getAttribute("href")
                    If DicoUrl.Exists(UrlCourse) Then
                       Debug.Print "Doublon", UrlCourse
                       GoTo ContinueFor
                    End If
                    DicoUrl.Add UrlCourse, UrlCourse
                    Discipline = Trim(elem.getElementsByClassName("category").Item(0).innerText)
                    Niveau = Trim(elem.getElementsByClassName("card-course__type").Item(0).innerText)
                    Catégorie = Trim(elem.getElementsByClassName("card-course__licences").Item(0).innerText)
                    DateCourse = Trim(elem.getElementsByClassName("card-course__date").Item(0).innerText)
                    Course = Trim(elem.getElementsByClassName("h3").Item(0).innerText)
                    Région = Trim(elem.getElementsByClassName("card-course__infos__right").Item(0).innerText)
                    'Set elemInfos = elem.getElementsByClassName("card-course__infos").Item(0).innerText
 
 
                    If (Catégorie = "U15, U17") Or (Catégorie = "U17") Then
                       cellDep.offset(z, 0).value = Discipline
                       cellDep.offset(z, 1).value = Niveau
                       cellDep.offset(z, 2).value = Catégorie
                       cellDep.offset(z, 3).value = UrlCourse
                       cellDep.offset(z, 4).value = DateCourse
                       cellDep.offset(z, 5).value = Course
                       cellDep.offset(z, 6).value = Région
                       z = z + 1
                    End If
ContinueFor:
                Next elem
        End If
  Next x
 Debug.Print "Fin"
 Set xmlHttpRequest = Nothing
 Set HtmlDoc = Nothing
Exit Sub
ErrWeb:
MsgBox "Impossible de lancer la recherche Web "
End Sub

Les champs sont extraits plus précisément (1 par colonne). Pour les doublons j'utilise un dictionnaire car je n'ai pas compris le fait que tu utilises les anciennes données car si tu effaces tout et que tu recharges normalement tu as les données à jour (anciennes dates effacées et nouvelles dates présentes). Il y a le filtre sur U15 U17. Pour balayer toutes les pages je met 100 au départ et si il n'y a plus de résultats je sors. Je n'ai pas inclus le tri vu que les données arrivent par date.

Ami calmant, J.P

importation de page web avec pagination

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager