validation donnée sous thisworkbook

[legamin]

Bonsoir.
Grace au forum et particulièrement à job 75 j’avance pas à pas (pas doué en Visual basic).
Mon souci est le suivant.
-j aimerais pouvoir saisir en validation des donnée sur thisworkbook, des données différentes dans chaque cellule sur la même base de validation des données liste.
Exemple
Cellule $a$1 identique sur les 4 feuilles.
Cellule $a$2 identique sur les 4 feuilles.
Cellule $a$3 ident……. Etc. etc.
Que dois-je rajouter pour rendre ceci possible.
Voici l’exemple en fichier.
Regarde la pièce jointe exemple Classeur.xlsm.
par avance merci.
cordialement j-p.m

 

[job75]

Re : validation donnée sous thisworkbook

Bonsoir legamin,

On ne peut évidemment pas ouvrir votre fichier 😱 mais j'ai bien compris votre problème.

La macro à placer dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim tablo(), plage As Range, i As Byte
tablo = Array([COLOR="Red"]"Feuil1", "Feuil2", "Feuil3", "Feuil4"[/COLOR]) 'liste des noms des feuilles à traiter
Set plage = Intersect(Source, Sh.Range("[COLOR="red"]A1:A100[/COLOR]")) 'A1:A100 => plage à adapter
If plage Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Source In plage
  For i = 0 To UBound(tablo)
    Sheets(tablo(i)).Range(Source.Address) = Source
  Next
Next
Application.EnableEvents = True
End Sub

En rouge ce qu'il faut adapter au fichier réel (n'écrivez pas une plage avec un nombre exagéré de cellules...).

Edition : s'il existe d'autres feuilles qui n'ont rien à voir avec celles de la liste, elles ne seront pas modifiées, mais par contre elles modifieront celles de la liste. Il faut alors un test supplémentaire :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim tablo(), plage As Range, i As Byte
tablo = Array("Feuil1", "Feuil2", "Feuil3", "Feuil4") 'liste des noms des feuilles à traiter
[COLOR="Red"]If IsError(Application.Match(Sh.Name, tablo, 0)) Then Exit Sub[/COLOR] 'si la feuille mofifiée n'est pas dans la liste
Set plage = Intersect(Source, Sh.Range("A1:A100")) 'A1:A100 => plage à adapter
If plage Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Source In plage
  For i = 0 To UBound(tablo)
    Sheets(tablo(i)).Range(Source.Address) = Source
  Next
Next
Application.EnableEvents = True
End Sub

A+

 

[job75]

Re : validation donnée sous thisworkbook

Re,

On peut éviter une boucle For/Next de la macro précédente en écrivant :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim tablo(), plage As Range, i As Byte
tablo = Array("Feuil1", "Feuil2", "Feuil3", "Feuil4") 'liste des noms des feuilles à traiter
If IsError(Application.Match(Sh.Name, tablo, 0)) Then Exit Sub 'si la feuille mofifiée n'est pas dans la liste
Set plage = Intersect(Source, Sh.Range("A1:A100")) 'A1:A100 => plage à adapter
If plage Is Nothing Then Exit Sub
Application.EnableEvents = False
For i = 0 To UBound(tablo)
  Sheets(tablo(i)).[COLOR="Red"]Range(plage.Address)[/COLOR] = [COLOR="Red"]plage.Value[/COLOR]
Next
Application.EnableEvents = True
End Sub

Nota : j'ai oublié de préciser que plage peut être composée de plusieurs cellules quand on y fait une entrée multiple (Ctrl+Entrée) ou qu'on les efface toutes en même temps.

A+