Rajouter des éléments si la cellule contient une lettre

Bonjour à tous,

Je sollicite votre aide car je bloque sur une procédure VBA dont je ne trouve pas la solution.

Je vous explique, dans le fichier ci-joint, je souhaite ajouter des informations à partir de la ligne D29 et celle du dessous lorsque une lettre apparait dans les cellule de passage de bus à l'appuie sur le bouton "Valider" du UserForm

Si la lettre "a" apparait dans une des cellule du tableau "Lundi à vendredi" ou "Samedi", il faut rajouter automatiquement dans les cellules en dessous du tableau "Samedi" à partir de la cellule D29.

les renvois sont renseignés dans la feuille "Renvois".

Pour tester, sélectionner la "Ligne 1" et l'arrêt "Tilleul" en sens Aller.

Je reste à votre disposition pour plus de détails si je n'ai pas été assez clair.

Merci d'avance.

Lyesse

Bonjour,

Je ne réussis pas à comprendre ce qu'il faut ajouter dans les cellules à partir de la cellule D29 si un a apparaît à l'horaire ...

EDIT : > c'est bon, je viens d'allumer > j'étais un peu humide ...

ric

Bonjour,

Un essai ...

Private Sub BtOK_Click()
    Application.ScreenUpdating = False

    With Me.CbArrets
        If Me.CbLignes.ListIndex > 0 And Me.CbArrets.ListIndex > 0 Then

            FModeleArret.Visible = xlSheetVisible
            FModeleArret.Unprotect ""

            FModeleArret.Copy After:=Sheets(F_Param.Name)
            If Me.ObAller.Value = True Then
                NomTemp = .Column(1) & " " & .Column(0) & "A"
            Else
                NomTemp = .Column(1) & " " & .Column(0) & "R"
            End If

            ActiveSheet.Name = NomTemp
            'Insertion du numéro de ligne
            ActiveSheet.Range("D3") = .Column(0)
            'Nom de l'arrêt
            ActiveSheet.Range("F2") = .Column(1)
            'Nom de la ville de l'arrêt
            ActiveSheet.Range("D1") = .Column(2)

            If ObAller.Value = True Then
                'Nom de l'arrêt du terminus
                ActiveSheet.Range("I3") = .Column(3)
                'Nom de la ville du terminus
                ActiveSheet.Range("M3") = .Column(4)
                ActiveSheet.Range("A2:A4").Value = "A"
                ActiveSheet.Range("B2").Value = "L"
                ActiveSheet.Range("B3").Value = "S"
                ActiveSheet.Range("B4").Value = "D"
            Else
                ActiveSheet.Range("I3").Value = .Column(5)
                ActiveSheet.Range("M3").Value = .Column(6)
                ActiveSheet.Range("A2:A4").Value = "R"
                ActiveSheet.Range("B2").Value = "L"
                ActiveSheet.Range("B3").Value = "S"
                ActiveSheet.Range("B4").Value = "D"
            End If
            ActiveSheet.Range("E25").Value = "a"    ' < ajouté seulement pour tester le code
            ActiveSheet.Range("E26").Value = "b"
            ActiveSheet.Range("E27").Value = "c"

        End If
    End With

    'Vérifier si la cellule contient le renvoi "a"
    If Application.WorksheetFunction.CountIf(ActiveSheet.Range("D16:X27"), "a") > 0 Then ActiveSheet.Range("D29") = Worksheets("Renvois").Range("A2")
    If Application.WorksheetFunction.CountIf(ActiveSheet.Range("D16:X27"), "b") > 0 Then ActiveSheet.Range("D30") = Worksheets("Renvois").Range("A3")
    If Application.WorksheetFunction.CountIf(ActiveSheet.Range("D16:X27"), "c") > 0 Then ActiveSheet.Range("D31") = Worksheets("Renvois").Range("A4")
    Unload Me
    Application.ScreenUpdating = True  ' < ce n'est nécessaire, cela se fera automatiquement à la fin de la macro
End Sub

ric

Bonjour Ric,

Super merci pour votre réponse.

Je vais tester et je vous tiens au courant.

Merci encore et bonne journée

Bonsoir Ric,

Je viens de tester et ça ne veut pas fonctionner.

Je ne sais pas pourquoi.

Bonjour,

Je te retourne ton fichier que je viens de tester à nouveau ...

Il y a ce petit bout de code qui écrase tes formules > ce n'est que pour avoir un a, b, ou c dans la plage afin de tester l'écriture des "Renvois" ...

Ce sera à supprimer quand le code fonctionnera à ta convenance ...

            ActiveSheet.Range("E25").Value = "a"    ' < ajouté seulement pour tester le code
            ActiveSheet.Range("E26").Value = "b"
            ActiveSheet.Range("E27").Value = "c"

ric

Oui effectivement comme ça, ça marche, mais le soucis c'est que les cellules auront des minutes "avec" une lettre à sa droite pour le renvoi.

Penses-tu que comme ça ça peut marcher :

For I = 1 To LastRow
For J = 1 To LastCol
If Right(Cells(I, J), 1) = "a" Then
ActiveSheet.Range("D29").Value = Range("Renvoi_1a").Value
With ActiveSheet.Range("D29").Characters(Start:=1, Length:=3).Font
.Name = "Ubuntu"
.Size = 11
.FontStyle = "Gras"
End With
End If

Bonjour,

Tu n'avais pas mentionné que les lettre a, b et c seraient accompagnées dans une même cellule par d'autres informations ...

Je regarde la chose et ton bout de code soumis ...

ric

Pardon,

C'est vrai que des fois quand on veut expliquer quelque chose, c'est tellement évident pour nous qu'on ne le mentionne pas.

Pour être encore plus clair, il faudrait que s'il y a un "a" à droite de l'horaire il prenne le renvoi avec "a" de la feuille "Renvoi" en cellule "D29", s'il n'y a pas de renvoi "a" mais "b" qu'il prenne le renvoi de la feuille "Renvois" et la mettre en cellule "D29". Ce qui veut dire qu'il affiche toujours le premier renvoi en cellule "D29" et les autres en-dessous s'il y en a, j'espère que c'est clair pour toi ?

Désolé et merci

Bonjour,

Woulla la bête ...

ric

C'est Excellent MERCI Ric.

T'es trop fort, tu me sauve la mise.

Je te souhaite tout de bon

ric