Boucle Do While

Hello,

Étant débutant en VBA, je m'en remet a vous pour solutionner mon problème. Celui ci se trouve dans une boucle "Do While". Ce que je veux faire est extraire des toutes les 10 valeurs d'une liste et les copier dans une colonne voisines. Voici le code (c'est pas de la haute voltige mais c'est mes premiers pas):

Code:

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
Sub Axe_y()
Dim i As Double, debuty As Double, finy As Double, j As Double
 
 
i = 1
Do While (ActiveSheet.Cells(i, 8) <> "I Stack")
   i = i + 1
Loop
debuty = i + 1      'stockage de la première valuer dans debut
 
 
i = debuty + 1
Do While (ActiveSheet.Cells(i, 8) <> "")        'recherche de la fin quand la case est vide
    i = i + 1
Loop
finy = i        'stockage de la valeur de fin dans finy
 
Columns(18).Select      'mise au format standard
    Selection.NumberFormat = "General"
Columns(16).Select
    Selection.NumberFormat = "General"
 
i = 1
For i = 1 To finy       'copie toutes les 10valeurs de la 8ième colonne dans la 16ième colonne
    ActiveSheet.Cells(debuty + i - 1, 16) = ActiveSheet.Cells((debuty + i - 1), 8)
    i = i + 10
Next
 
ActiveSheet.Cells(debuty, 18) = "I Stack"       'inscription dans la cellule
 
i = 1
 
For j = 1 To finy       'suppression des espaces entre les valeures
    Do While (ActiveSheet.Cells(i, 16) = "")
    i = i + 1
    Loop
    ActiveSheet.Cells(debuty + j, 18) = ActiveSheet.Cells(i, 16)
    i = i + 1
Next
 
End Sub

Le probleme vient du dernier Do While. Je pense qu'il devrait y avoir une condition (exemple: >, < ou <>) mais dans ce cas je ne vois pas la suite...

Merci de vos reponses

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Dim LastLig As Long, Deb As Long, i As Long
Dim c As Range
 
LastLig = Range("H65536").End(xlUp).Row
 
Set c = Range("H1:H" & LastLig).Find("I Stack", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not c Is Nothing Then
    Deb = c.Row + 1
    For i = Deb To LastLig Step 10
        Cells(i, 16) = Cells(i, 8)
    Next i
End If

Ok Sa marche!!!
Merci a toi