Selectionner les cellules de 1 ligne avec VBA
Résolu
Orione
Messages postés
9
Date d'inscription
Statut
Membre
Dernière intervention
-
Orione Messages postés 9 Date d'inscription Statut Membre Dernière intervention -
Orione Messages postés 9 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Selectionner les cellules de 1 ligne avec VBA
- Partage de photos en ligne - Guide
- Mètre en ligne - Guide
- Aller à la ligne dans une cellule excel - Guide
- Formule excel pour additionner plusieurs cellules - Guide
- Formulaire en ligne de meta - Guide
2 réponses
Bonjour,
Remplacez E303 par la derniere cellule de votre ligne
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
Merci pour votre réponse rapide! ça marche :)
Je vous souhaite une belle journée.
Salutations
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
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