Hello tout le monde .... je me retrouve coincé face à une boucle de parcours !
j'ai fais un bout de code qui me permet de parcourir un tableau à la recherche d'éléments :

- qui duplique la ligne si le nombre d'éléments est supérieur à 2
- qui copie le contenu de certaines données voulues dans 2 colonnes au préalablement crées

le tout fonctionne uniquement sur la première ligne de la partie à parcourir.
Je n'arrive pas à faire la boucle qui parcours le tout ....

Voici mon 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
Sub formatProductLines()
 
Dim Parcours1 As Integer, Parcours2 As Integer
Parcours1 = 1
ligne = 1
Dim tempContentName As String
Dim tempHeadline As String
Dim pLCount As Integer
Dim nbDealers As Integer
 
Do While Cells(ligne, Parcours1).Value <> "-"         ' on parcours les headlines mais seulement jusqu'à ce qu'il y ai un "-"
    If Cells(ligne, Parcours1) = "ATV" _
    Then                                              ' on a trouvé ou commencer à faire la recherche des sales rep
        ligne = ligne + 1
        Parcours2 = Parcours1
        nbDealers = NbEntries
        Do While ligne < nbDealers                        ' Boucle qui parcours le tableau à la vertical
            pLCount = 0                                   ' on met le compteur de ProductLines à zéro
            Do While Cells(ligne, Parcours2).Value <> "-" ' on parcours les cellules des Product Lines
                If Cells(ligne, Parcours2) <> "" _
                Then                                      ' on a trouvé un Product Line qui contient un Sales Rep
                    pLCount = pLCount + 1                 ' on a trouvé un Product Line --> on augmente de 1
 
                    If pLCount >= 2 Then                  ' la copie des lignes se fait uniquement si il y a au moins 2 éléments
                        ' ----------------------------
                        Cells(ligne, Parcours2).Select    ' sélectionne la cellule courante
                        ActiveCell.EntireRow.Select       ' sélectionne la ligne complète ou se trouve la cellule
                        Selection.Copy                    ' Met la ligne en mémoire (copie)
                        Selection.Insert Shift:=xlDown    ' Duplique la ligne et déplace le tout vers le bas
 
                        Cells(ligne, Parcours2).Select
                        tempContentName = Cells(ligne, Parcours2).Value
                        tempHeadline = Cells(1, Parcours2).Value
 
                        Cells(ligne, ProductLinesPosition).Value = tempHeadline
                        Cells(ligne, SalesRepPosition).Value = tempContentName
                        ' ----------------------------
                    End If
 
                    If pLCount = 1 Then
                        ' ----------------------------
                        Cells(ligne, Parcours2).Select
                        tempContentName = Cells(ligne, Parcours2).Value          ' on recupère le nom du sales rep dans une var
                        tempHeadline = Cells(1, Parcours2).Value                 ' on recupère le nom du pline dans une variable
 
                        Cells(ligne, ProductLinesPosition).Value = tempHeadline  ' on copie le contenu de la var dans la cell finale
                        Cells(ligne, SalesRepPosition).Value = tempContentName   ' on copie le contenu de la var dans la cell finale
                        ' ----------------------------
                    End If
 
                End If
                Parcours2 = Parcours2 + 1
            Loop
            ligne = ligne + 1
        Loop
    End If
    Parcours1 = Parcours1 + 1
Loop
 
End Sub
 
' ----------------------------------------------------------------------------
' ----------------------------------------------------------------------------
 
Function NbEntries()
 
NbEntries = 1
 
Do While Cells(NbEntries, 1).Value <> ""
    NbEntries = NbEntries + 1
Loop
 
NbEntries = NbEntries - 1
 
End Function