Exécuter une une boucle For Each verticalement

Bonjour,

Après avoir cherché sur le web, je suis tombé sur un article, mais sans succès.

L' exécution de la boucle for Each se fait de gauche à droite, puis de haut en bas.

Je souhaite que l'exécution se fasse d'abord verticalement.

La commande se fait depuis un Userform sur la sélection

"Vc" et "Base" sont des variables reprise du Userform.

PL Représente la sélection et CL les cellules

Private Sub Button_C01_Fly_Click()
Dim Vc As Single, Base As Single, Av As Boolean, PL As Range, CL As Range
Set PL = Selection
Av = True

Base = Droit.Caption
Vc = Vac.Caption

ActiveSheet.Unprotect 

For Each CL In PL

    If Av = True Then
        If Vc <= 0 Then
        Question = MsgBox("Le quota est à 0, si vous continuez il sera en négatif, Continuer?", vbYesNo + vbDefaultButton2, "Solde épuisé")
            If Question = vbNo Then
            Exit Sub
            Else
            Av = False
            End If
        End If

    End If
    If Vc > Base Then
        If CL.DisplayFormat.Interior.ColorIndex = xlNone Then
        CL.Value = "VA"
        CL.Interior.Color = RGB(0, 176, 240)
        CL.Font.Color = RGB(0, 176, 240)
        Vc = Vc - 0.5
        End If

    Else
        If CL.DisplayFormat.Interior.ColorIndex = xlNone Then
        CL.Value = "V"
        CL.Interior.Color = RGB(0, 40, 250)
        CL.Font.Color = RGB(0, 40, 250)
        Vc = Vc - 0.5
        End If

    End If
Next CL

End Sub

Je vous remercie d'avance

Bonjour,

Il faut balayer la zone en passant par 2 boucles sur le principe suivant:

    For i = 1 To DerLig 'Balayage par ligne
        For j = 1 To DerCol 'Balayage par colonne
            'déroulement du programme
        Next j
    Next i

Cdlt=

Bonjour,

Ca fonctionne, je vous remercie.

L'adaptation donne

Private Sub Button_C01_Fly_Click()
Dim Vc As Single, Base As Single, Av As Boolean, PL As Range, CL As Range, DerCol As Integer, Derlig As Integer, StX As Integer, StY As Integer

StX = ActiveCell.Row - 1
StY = ActiveCell.Column - 1
Set PL = Selection

Derlig = Selection.Rows.Count
DerCol = Selection.Columns.Count

Av = True

Base = Droit.Caption
Vc = Vac.Caption

ActiveSheet.Unprotect
For b = 1 To DerCol
    For a = 1 To Derlig

    Set CL = Cells(StX + a, StY + b)
    If Av = True Then
        If Vc <= 0 Then
        Question = MsgBox("Le quota est à 0, si vous continuez il sera en négatif, Continuer?", vbYesNo + vbDefaultButton2, "Solde épuisé")
            If Question = vbNo Then
            Exit Sub
            Else
            Av = False
            End If
        End If

    End If
    If Vc > Base Then
        If CL.DisplayFormat.Interior.ColorIndex = xlNone Then
        CL.Value = "VA"
        CL.Interior.Color = RGB(0, 176, 240)
        CL.Font.Color = RGB(0, 176, 240)
        Vc = Vc - 0.5
        End If

    Else
        If CL.DisplayFormat.Interior.ColorIndex = xlNone Then
        CL.Value = "V"
        CL.Interior.Color = RGB(0, 40, 250)
        CL.Font.Color = RGB(0, 40, 250)
        Vc = Vc - 0.5
        End If

    End If

    Next a
Next b

ActiveCell.Select
PL.Select

End Sub