Selectionner les cellules de 1 ligne avec VBA [Résolu]

Signaler
Messages postés
9
Date d'inscription
samedi 4 avril 2009
Statut
Membre
Dernière intervention
16 mars 2021
-
Messages postés
9
Date d'inscription
samedi 4 avril 2009
Statut
Membre
Dernière intervention
16 mars 2021
-
Bonjour,

Voici ci-dessous, un code VBA que j'utilise actuellement et qui fonctionne très bien :

Option explicit
-------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
Dim Newvalue As String

Application.EnableEvents = True

On Error GoTo Exitsub
If Target.Address = "$B$303" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Application.EnableEvents = True

Exitsub:
Application.EnableEvents = True

End Sub

Seul problème, est qu'il fonctionne uniquement sur la cellule $B$303
J'aurais besoin qu'il fonctionne également sur les cellules suivantes, à savoir : $C$303, $D$303, $E$303 etc...

Je suis vraiment nulle en VBA, ce serait fortement apprécié si l'un d'entre vous pouvait m'aider à modifier le code.

Merci d'avance pour votre aide
Salutations
Aldeberan


Configuration: Windows / Edge 89.0.774.45

2 réponses

Messages postés
15804
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
9 juin 2021
1 502
Bonjour,
Remplacez E303 par la derniere cellule de votre ligne
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("B303:E303")) Is Nothing Then
        Application.EnableEvents = True
        On Error GoTo Exitsub
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        ElseIf Target.Value = "" Then
            GoTo Exitsub
        Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                Target.Value = Oldvalue & ", " & Newvalue
            End If
        End If
    End If
Exitsub:
    Application.EnableEvents = True
End Sub
Messages postés
9
Date d'inscription
samedi 4 avril 2009
Statut
Membre
Dernière intervention
16 mars 2021

Bonjour,

Merci pour votre réponse rapide! ça marche :)

Je vous souhaite une belle journée.
Salutations
Messages postés
9
Date d'inscription
samedi 4 avril 2009
Statut
Membre
Dernière intervention
16 mars 2021

Rebonjour,

Je suis désolée de vous déranger. Votre code fonctionne parfaitement sur toute la ligne.

Comment devrais-je le modifier si je souhaite avoir le même genre d'action sur une autre ligne (par exemple, dans votre code on a sélectionné les cellules de B303 à E303. Comment faire pour le faire également sur les cellules B191 à E191?)

J'espère que vous pourrez m'aider.

Merci encore
Toute belle journée
Messages postés
15804
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
9 juin 2021
1 502 >
Messages postés
9
Date d'inscription
samedi 4 avril 2009
Statut
Membre
Dernière intervention
16 mars 2021

Bonjour,

J'espère que vous pourrez m'aider
Pas de problemc, je vous fais la chose.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("B303:E303")) Is Nothing Then
        Application.EnableEvents = True
        On Error GoTo Exitsub
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        ElseIf Target.Value = "" Then
            GoTo Exitsub
        Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                Target.Value = Oldvalue & ", " & Newvalue
            End If
        End If
    ElseIf Not Application.Intersect(Target, Range("B191:E191")) Is Nothing Then
            'votre code
    End If
Exitsub:
    Application.EnableEvents = True
End Sub
Messages postés
9
Date d'inscription
samedi 4 avril 2009
Statut
Membre
Dernière intervention
16 mars 2021

Bonjour,

C'est parfait! Je vous remercie infiniment.

Toute belle journée!