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
| Private Sub Worksheet_Change(ByVal Target As Range)
Dim TheName
Dim ListeCell As String
Dim Position
'Si plusieur cellule sont impacté par une modif
'Ou si la cellule n'est pas nommé on quite
On Error Resume Next
TheName = Target.Name.NameLocal
On Error GoTo 0
If (Target.Count > 1) Or IsEmpty(TheName) Then Exit Sub
'On supprime la reference a la semaine si elle est presente ('Fevrier'!)
TheName = Replace(TheName, "'" & Target.Worksheet.Name & "'!", "")
'On defini les cellules sur lequelle on réagira
ListeCell = ",luS6,maS6,merS6,jeuS6,venS6," 'bien garder ',' au début et a la fin de la chaine
'For Each TheName In Array("luS6", "maS6","merS6","jeuS6",venS6")
If InStr(1, ListeCell, "," & TheName & ",") Then
With Target
'On arrete la generation d'evenement pour ne pas faire un boucle infini...
Application.EnableEvents = False
Range(Cells(.Row, "C"), Cells(.Row, "X")).Insert
.Offset(-1, 0).Value = .Value
.Value = ""
Application.EnableEvents = True
With .Offset(-1, 1)
.Select
'On rajoute la formule en colonne H
.Offset(0, 3).Formula = "=E" & .Row & "*F" & .Row
End With
End With
End If
End Sub |
Partager