Macro boucle sur valeur d´une colone

[akrillon]

Bonjour le forum,

J´ai recupéré une macro quelque part et l´ai adapté.
mais j´ai encore un probleme...

Sub Macro1()
 Dim O As Object 'déclare la variable O (Onglet)
 Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
 Dim PL As Range 'déclare la variable PL (PLage)
 Dim CEL As Range 'déclare la variable CEL (CELlule)
 Dim TB() As Integer 'déclare le tableau de variables TB (TaBleau)
 Dim I As Integer 'déclare la variable I (Incrément)
 Dim x As Range 'déclare la variable CEL (CELlule)

 Set x =Range("A2")
 Set O = Sheets("Feuil1") 'définit l'onglet O
 DL = O.Cells(Application.Rows.Count, 8).End(xlUp).Row 'définit la dernière cellule éditée DL de la colonne 8 (=H) de l'onglet O
 Set PL = O.Range("H2:H" & DL) 'définit la plage PL
 For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
     If CEL.Value = x Then 'condition : si la cellule vaut "x"
         ReDim Preserve TB(I) 'redimensionne le tableau de variables TB
         TB(I) = CEL.Row 'récupère le numéro de ligne dans la variable indexée TB(I)
         I = I + 1 'incrémente I
     End If 'fin de la condition
 Next CEL 'prochaine cellule de la boucle
 'on obtient dans cet exemple un tableau de 6 variables TB(0) à TB(5)
 DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'redéfinit la variable DL (ernière cellule éditée DL de la colonne 1 (=A) de l'onglet O)
 For I = 2 To DL 'boucle de la ligne 2 à DL
     O.Cells(I, 1).Resize(, 4).Copy O.Cells(TB(I - 2), 9) 'copie la cellule ligne 1, colonne 1 redimensionnée jusqu'à la colonne D et colle dans la cellule ligne TB(I-2), colonne 9
 Next I 'prochaine ligne de la boucle
 'cette macro plantera si il y a plus de ligne en colonne A que de "x" en colonne H...
 End Sub

j´aimerais que ma valeur "x" ici (A2) soit boucler pour faire toute les valeur de la colone A ( A1 ensuite A2, ensuite A3 etc...)

Pouvez vous m´aider?

Merci

 

[Robert]

Re : Macro boucle sur valeur d´une colone

Bonjour Akrillon, bonjour le forum,

Je me demande à quoi ça sert que je commente mes codes...?! Si tu avais ne serait-ce que lu les commentaires tu aurais dû t'apercevoir que la boucle se faisait sur les cellules de la Colonne H alors que tu demandes à boucler sur la colonne A.
L'idéal serait que tu mettes un fichier exemple avec ce que tu as avant le traitement par la macro et ce que tu désires après. Car je ne suis pas sûr que tu veuilles exactement ce que le code récupérée exécute...

 

[akrillon]

Re : Macro boucle sur valeur d´une colone

Bonjour robert,

Merci de t´as participation voici un fichier récap.

 

[Robert]

Re : Macro boucle sur valeur d´une colone

Bonsoir Akrillon, bonsoir le forum,

Pas compris pourquoi dans avant il y a deux tableaux alors que dans après il y en a quatre ??? Quoi qu'il en soit, si tu veux appliquer le code sur les deux derniers tableaux de l'onglet après tu devrais pouvoir l'adapter facilement avec les commentaires que j'ai fait (si tu les lis)...
Le code à affecter au bouton :

Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DLS As Integer 'déclare la variable DL (Dernière Ligne Source)
Dim PLS As Range 'déclare la variable PL (PLage Source)
Dim CELS As Range 'déclare la variable CELS (CELlule Source)
Dim DLC As Integer 'déclare la variable DLC (Dernière Ligne à Comparer)
Dim PLC As Range 'déclare la variable PLC (PLage à Comparer)
Dim CELC As Range 'déclare la variable CELC (CELlule à Comparer)

Set x = Range("A2")
Set O = Sheets("avant") 'définit l'onglet O (à adapter)
DLS = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière cellule éditée DLS de la colonne 1 (=A) de l'onglet O
Set PLS = O.Range("A2:A" & DLS) 'définit la plage PLS
DLC = O.Cells(Application.Rows.Count, 8).End(xlUp).Row 'définit la dernière cellule éditée DLC de la colonne 8 (=H) de l'onglet O
Set PLC = O.Range("H2:H" & DLC) 'définit la plage PLC
For Each CELS In PLS 'boucle 1 : sur toutes les cellules CELS de la plage PLS
    For Each CELC In PLC 'boucle 2 : sur toutes les cellules CELC de la plage PLC
        If CELS.Value = CELC.Value Then 'condition : si la cellule CELS de la boucle 1 est égale à la cellule CELC de la boucle 2
            'place dans la cellule CELC décalée d'un colonne à droite (=colonne I), la valeur de la cellule CELS
            CELC.Offset(0, 1).Value = CELS.Value
            'place dans la cellule CELC décalée de deux colonnes à droite (=colonne J),
            'la valeur de la cellule CELS décalée d'une colonne à droite (=colonne B)
            CELC.Offset(0, 2).Value = CELS.Offset(0, 1).Value
            'place dans la cellule CELC décalée de trois colonnes à droite (=colonne K),
            'la valeur de la cellule CELS décalée de deux colonnes à droite (=colonne C)
            CELC.Offset(0, 3).Value = CELS.Offset(0, 2).Value
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next CELC 'prochaine cellule de la boucle 2
Next CELS 'prochaine cellule de la boucle 1
End Sub

 

[akrillon]

Re : Macro boucle sur valeur d´une colone

Bonjour robert,

Je viens de regarder effectivement si j´adapte tout cela, plus de probleme, merci beaucoup d´avoir passé du temps dessus. je vais essayer de bien comprendre tout cela.

Merci encore