Même Macros sur plusieurs lignes

[dhidhou]

Bonjour,

débutant j'ai besoin de votre aide:

tout d'abbord je voulais avoir une liste déroulante avec choix multiple et j'ai réussi à trouver le code nécéssaire :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$7" And Target.Count = 1 Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
p = InStr(Target, ValSaisie)
If p > 0 Then
Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
If Right(Target, 1) = Chr(10) Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & Chr(10) & ValSaisie
End If
End If
Application.EnableEvents = True
End If
If Target.Address = "$F$7" And Target.Count = 1 Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
p = InStr(Target, ValSaisie)
If p > 0 Then
Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
If Right(Target, 1) = Chr(10) Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & Chr(10) & ValSaisie
End If
End If
Application.EnableEvents = True
End If
If Target.Address = "$G$7" And Target.Count = 1 Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
p = InStr(Target, ValSaisie)
If p > 0 Then
Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
If Right(Target, 1) = Chr(10) Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & Chr(10) & ValSaisie
End If
End If
Application.EnableEvents = True
End If
If Target.Address = "$H$7" And Target.Count = 1 Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
p = InStr(Target, ValSaisie)
If p > 0 Then
Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
If Right(Target, 1) = Chr(10) Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & Chr(10) & ValSaisie
End If
End If
Application.EnableEvents = True
End If
End Sub


Comme vous constatez ce code s'applique sur la ligne 7 et les Colonnes D, F, G et H.

ce que je voulais faire c'est appliquer ce meme code sur toute les lignes à partir de la 7eme ligne jusqu'a la ligne Nr 100 et si possible aussi de simplifier le code sur les colonnes citées en haut(D, F, G et H)

Merci infiniment

 

[Jacou]

Re : Même Macros sur plusieurs lignes

Bonsoir,
essaie cela :

Private Sub Worksheet_Change(ByVal Target As Range)


For lig = 7 To 100
If Target.Address = "$D$" & lig Or Target.Address = "$F$" & lig _
Or Target.Address = "$G" & lig Or Target.Address = "$H$" & lig _
And Target.Count = 1 Then
Application.EnableEvents = False
ValSaisie = Target
Application.Undo
p = InStr(Target, ValSaisie)
If p > 0 Then
Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
If Right(Target, 1) = Chr(10) Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & Chr(10) & ValSaisie
End If
End If
Application.EnableEvents = True
End If
Next lig
End Sub

 

[Philippe68]

Re : Même Macros sur plusieurs lignes

Bonsoir,

En mettant en rouge ceci :

If Target.Address = "$D$7:$D$100" And Target.Count = 1 Then

Pas testé puisque pas de fichier à disposition...

 

[dhidhou]

Re : Même Macros sur plusieurs lignes

merci beaucoup ca a marché sauf pour la colonne G et je ne sais pas pourquoi ca marche pas

 

[dhidhou]

Re : Même Macros sur plusieurs lignes

c'est bon j'ai corrigé "$G$"
merci beaucoup pour ton aide Philippe68

 

[Philippe68]

Re : Même Macros sur plusieurs lignes

de rien