Bonjour à tous,
voici mon code qui fonctionne: (celui-ci est placé dans le thisworkbook)
Je voudrais savoir comment faire pour que ce code fonctionne sur tout les feuilles de mon document excel.?
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'permet de sortir de la procédure si plus d'une cellule est sélectionnée '(sinon la suite de la macro renvoie un message d'erreur) If Target.Count > 1 Then Exit Sub If Target.Column = "11" Then MsgBox "Vous venez de modifier " & Target.Row & "la cellule " & Target.Address & " (" & Target.Value & ")" MsgBox (WorksheetFunction.VLookup(Target.Value, Sheets("BD_parametre").Range("A3:B10"), 2, False)) Dim today As Date today = Date MsgBox (today) mm = today + WorksheetFunction.VLookup(Target.Value, Sheets("BD_parametre").Range("A3:B10"), 2, False) MsgBox ("mm" & mm) MsgBox (Range("A" & Target.Row).Value) Total = Range("A" & Target.Row).Value - mm MsgBox (Total) If (Total < 0) Then MsgBox ("Impossible de faire la livraison à cette date...la date minium est de " & mm & "") Range("H" & Target.Row & ":K" & Target.Row).ClearContents End If ElseIf Target.Column = "7" Then x = Application.WorksheetFunction.SumIf(Range("A4:A300"), Range("A" & Target.Row).Value, Range("g4:g300")) MsgBox (x) If (x >= 8) Then MsgBox ("impossible ajouter une nouvelle preparation le quota de 8h maximun est atteint, merci de programmer cela à une autre date") Range("D" & Target.Row & ":G" & Target.Row).ClearContents End If Else: Exit Sub End If End Sub
Car sur la première page c'est bon, mais sur la 2eme /3eme cela ne fonctionne pas.
Quel erreur est-je commis ?
merci d'avance pour votre aide
guigui69
Partager