VBA : Private Sub Worksheet_Change(ByVal Target As Range) sur une plage de cellules

[dionys0s]

Bonjour le forum

j'ai le code suivant pour sélectionner une cellule si une cellule est modifiée :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$22" Then
Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select
End If

End Sub

Il marche au poil, mais j'aimerais qu'il prenne en compte cette demande non pas pour A22 uniquement, mais pour toutes les cellules de la plage A22:A68. A savoir quelle que soit la cellule de cette plage modifiée, il se décale de une cellule sur la droite. C'est posssible sans passer par ce type de code ? :

If Target.Address = "$A$22" Then
Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select

ElseIf Target.Address = "$A$23" Then
Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select

...

ElseIf Target.Address = "$A$68" Then
Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select

Thanks in advance pour your help ^^

 

[Pierrot93]

Re : VBA : Private Sub Worksheet_Change(ByVal Target As Range) sur une plage de cellu

Bonjour,

essaye ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A22:A683")) Is Nothing Then
    Target.Offset(0, 1).Select
End If
End Sub

bonne journée
@+

 

[dionys0s]

Re : VBA : Private Sub Worksheet_Change(ByVal Target As Range) sur une plage de cellu

Ca ne marche pas. Enfin si ça marche mais à l'ouverture et à la fermeture du classeur ton code fait buger la macro.

Voici mon code dans ma Feuil1 (à la fin ta contribution) :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$1" Then
Application.ScreenUpdating = False
    Call AdresseSociété

ElseIf Target.Address = "$B$2" Then
Application.ScreenUpdating = False
    Range("E4").ClearContents
    Call Liste_Valideurs
    Range("E3").Select

ElseIf Target.Address = "$E$3" Then
Application.ScreenUpdating = False
    Call TelFax

ElseIf Target.Address = "$E$4" Then
Application.ScreenUpdating = False
    Range("A22").Select

ElseIf Not Intersect(Target, Range("$A$22:$A$68")) Is Nothing Then
    Target.Offset(0, 1).Select

End If

End Sub

Et un code dans ThisWorkBook qui fait peut-être planter mon bazar du coup je pense :

Private Sub Workbook_Open()

If ThisWorkbook.ReadOnly Then ThisWorkbook.Close False

Call Actualisation

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.ScreenUpdating = False

Feuil1.Visible = True
Feuil1.Select
Cells.Select
Selection.ClearContents
Range("A1").Select

Feuil2.Visible = True
Feuil2.Select
Cells.Select
Selection.ClearContents
Range("A1").Select

Feuil3.Visible = True
Feuil3.Select
Cells.Select
Selection.ClearContents
Range("A1").Select

Feuil4.Visible = True
Feuil4.Select
Cells.Select
Selection.ClearContents
Range("A1").Select

Feuil5.Visible = True
Feuil5.Select
Cells.Select
Selection.ClearContents
Range("A1").Select

Feuil6.Visible = True
Feuil6.Select
Cells.Select
Selection.ClearContents
Range("A1").Select

Feuil7.Visible = True
Feuil7.Select
Cells.Select
Selection.ClearContents
Range("A1").Select

Feuil7.Visible = False
Feuil6.Visible = False
Feuil5.Visible = False
Feuil4.Visible = False
Feuil3.Visible = False
Feuil2.Visible = False

ActiveWorkbook.Save

Application.ScreenUpdating = True

End Sub

c'est un peu l'usine à gaz j'en conviens mais je débute. Ca t'éclaire ?

 

[Pierrot93]

Re : VBA : Private Sub Worksheet_Change(ByVal Target As Range) sur une plage de cellu

Re,

Rajoute ceci sur la première ligne de la procédure "change" :

If Target.Count > 1 Then Exit Sub

@+

 

[dionys0s]

Re : VBA : Private Sub Worksheet_Change(ByVal Target As Range) sur une plage de cellu

...et la lumière fut.

Grand merci !!

 

[julien6337]

Bonjour,
je rebondis sur cette discussion. J'essaye d'appliquer ce qui est dit au dessus à mon code ci dessous.
Mon code ne s'applique que la cellule C30 (voir ligne 6), or je voudrais que l'application se fasse sur la plage (C30: DC30) mais je ne parviens pas à faire fonctionner cela.


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 = "$C$30" 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
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

 

[soan]

Bonjour julien6337,

Un essai :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error GoTo 1
  Dim Oldvalue$, Newvalue$
  With Target
    If .CountLarge > 1 Then Exit Sub
    If Intersect(Target, [C30:DC30]) Is Nothing Then Exit Sub
    If .SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    Newvalue = .Value: If Newvalue = "" Then Exit Sub
    Application.EnableEvents = False
    Application.Undo: Oldvalue = .Value
    If Oldvalue = "" Then
      .Value = Newvalue
    Else
      .Value = Oldvalue
      If InStr(Oldvalue, Newvalue) = 0 Then .Value = .Value & ", " & Newvalue
    End If
  End With
1 Application.EnableEvents = True
End Sub

soan