Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim s As Object, n%
Dim Cellule As Range, Nombre As Integer, Adresse As String, Plage As Range
'teste si la cellule modifiée est A4 et appelle la macro CopierDate
If Not Application.Intersect(Target, Range("A4")) Is Nothing Then
Call CopierDate
End If
'Je pense qu'on peut ajouter ta macro ici...
'Fais une sauvegarde de ton fichier et teste sur une copie, on sait jamais, comme je n'ai pas ton fichier il se pourrait que ça fasse des choses bizarres...
'*********************************************************
'ici on teste si la cellule qui a changé est dans la colonne 1 (A) et que sa valeur est non nulle
If Target.Column = 1 And Target.Value <> "" Then
'ici on teste maintenant de quelle nature est la valeur et s'il faut copier
Select Case True
Case Target.Value Like "*VAC*"
Target.Offset(0, 3).Value = Target.Value
Case Target.Value Like "*TRAV*"
Target.Offset(0, 3).Value = Target.Value
'si aucun des cas précedents n'est vrai
Case Else
Target.Offset(0, 3).Value = "Catégorie Inconnue"
End Select
End If
'*********************************************************
'teste si le range [ETB] est nul et appelle la macro Ve
If [ETB] <> 0 Then
Ve
Else
If [ETBA] <> 0 Then
Ve1
End If
End If
'teste si la cellule modifiée est dans BA4:BB80 et appelle la macro Tri, puis reunion puis retrier
If Not Intersect(Target, Range("BA4:BB80")) Is Nothing Then
Tri
reunion
Retrier
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'boucle sur toute les feuilles
For Each s In Sheets
n = Val(s.Name)
'supprime la feuille si elle n'apparait pas dans colonne BC ??? pas sur qd même là...
If Application.CountIf([BC:BC], s.Name) = 0 Then s.Delete
Next
End If
With Target
'là ça a l'air d'être très spécifique à l'utilisation du classeur, je ne m'aventure pas à commenter car il faudrait le fichier pour comprendre
If Intersect(Target, Range("B:C,G:H,L:M,Q:R,V:W,AA:AB,AF:AG,AK:AL,AP:AQ ")) Is Nothing Or .Text = "" Or .Count > 1 Then Exit Sub
Adresse = "B" & .Row - Weekday(Range("A" & .Row)) + 1 & ":W" & .Row - Weekday(Range("A" & .Row)) + 7
Set Plage = Intersect(Range(Adresse), Range("B:C,G:H,L:M,Q:R,V:W,AA:AB,AF:AG,AK:AL,AP:AQ "))
For Each Cellule In Plage
If Cellule = Target And Cellule.Column <> Target.Column Then
MsgBox "Il existe déjà une formation cette semaine pour cet établissement !", vbCritical + vbOKOnly, "ATTENTION !"
.ClearContents
Exit Sub
End If
Next Cellule
End With
'rafraichissement de l'affichage
Application.ScreenUpdating = True
'autorisation de l'affichage de messages Excel (erreurs, etc...)
Application.DisplayAlerts = True
End Sub