Boucle sur une colonne et écriture dans une autre

Bonjour,

Je cherche a créer un petit script qui se charge simplement de faire une boucle sur une colonne d'un tableau et à chaque ligne, celui-ci doit, en fonction de la valeur inscrite dans la case, écrire un caractère sur la même ligne mais deux colonnes dèrrière.

Mon script fonctionne mais j'ai un souci avec la boucle, celle-ci s'arrete au bout d'un moment et je ne comprends pas trop pourquoi.

J'espère que certains d'entre vous pourront m'aider, car je bloque dessus depuis plusieurs jours et j'avoue avoir fais le tour des modifications pour essayé de résoudre le problème.

Merci d'avance pour votre aide et bonne journée.

Pierro

Sub Try5()

    Sheets(tsr).Select

    Range("H5", Range("H5").End(xlDown)).Select
    Dim Cel As Range
    For Each Cel In Range("H5", Range("H5").End(xlDown))
    i = i + 1
        If Cel = "OK" Then
            Cel.Offset(, -2).Select
            ActiveCell.Formula = "C"
            ActiveCell.Interior.Color = 5287936
            ActiveCell.Borders.ColorIndex = 1
            ActiveCell.Borders.Weight = xlMedium
            ActiveCell.HorizontalAlignment = xlCenter
            ActiveCell.VerticalAlignment = xlCenter
        ElseIf Cel = "POK" Then
            Cel.Offset(, -2).Select
            ActiveCell.Formula = "PC"
            ActiveCell.Interior.ColorIndex = 44
            ActiveCell.Borders.ColorIndex = 1
            ActiveCell.Borders.Weight = xlMedium
            ActiveCell.HorizontalAlignment = xlCenter
            ActiveCell.VerticalAlignment = xlCenter
        ElseIf Cel = "NOK" Then
            Cel.Offset(, -2).Select
            ActiveCell.Formula = "NC"
            ActiveCell.Interior.ColorIndex = 3
            ActiveCell.Borders.ColorIndex = 1
            ActiveCell.Borders.Weight = xlMedium
            ActiveCell.HorizontalAlignment = xlCenter
            ActiveCell.VerticalAlignment = xlCenter
        Else
            Cel.Offset(, -2).Select
            ActiveCell.Formula = "Unknown"
        End If
        Next Cel
End Sub

Bonjour,

J'imagine que cela s'arrête dès qu'une cellule est vide dans la colonne H ?

Tu peux essayer ceci :

Sub Try5()

    Sheets(tsr).Select

    Dim Cel As Range
    Derligne = Cells(Rows.Count, 8).End(xlUp).Row
    For Each Cel In Range("H5:H" & Derligne)

        If Cel = "OK" Then
            with Cel.Offset(, -2)
                .value = "C"
                .Interior.Color = 5287936
                .Borders.ColorIndex = 1
                .Borders.Weight = xlMedium
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End with
        ElseIf Cel = "POK" Then
            With Cel.Offset(, -2)
                .value = "PC"
                .Interior.ColorIndex = 44
                .Borders.ColorIndex = 1
                .Borders.Weight = xlMedium
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End with
        ElseIf Cel = "NOK" Then
            with Cel.Offset(, -2)
                .value = "NC"
                .Interior.ColorIndex = 3
                .Borders.ColorIndex = 1
                .Borders.Weight = xlMedium
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End with
        Else
            Cel.Offset(, -2).value = "Unknown"
        End If
        Next Cel
End Sub