Bonjour,
Voilà le fichier corrigé et annoté.
Il restait un MIN(......) qui ne renvoyait qu'une valeur (toujours la première) que j'ai remplacé par un PETITE.VALEUR(....;nb.si(..)) qui renvoie les différentes valeurs une par une quand on recopie vers le bas.
Cordialement
Encore merci.
Dois je modifier le code macro afin de l adapter a mon fichier final, si le tableau récapitulatif n est pas situé exactement au même endroit ?
Option Explicit
Dim c As Range, adrD$
Dim i&, lgn&, derln&, ln&, lnS, nb&, jS$
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$Q$17" Then
Application.EnableEvents = False
Application.ScreenUpdating = False
Range("Q16").CurrentRegion.Offset(1, 1).ClearContents
derln = Range("A" & Rows.Count).End(xlUp).Row + Range("A" & _
Range("A" & Rows.Count).End(xlUp).Row).CurrentRegion.Rows.Count
With Range("A1:N" & derln)
Set c = .Find(Target, lookat:=xlWhole)
If Not c Is Nothing Then
adrD = c.Address
Do
c.Select
'MsgBox "ok"
For i = 1 To 7
lnS = Choose(i, 2, 40, 78, 116, 154, 192, 230)
ln = Choose(i, 40, 78, 116, 154, 192, 230, Rows.Count)
If c.Row < ln Then Exit For
Next i
lgn = Range("R" & Rows.Count).End(xlUp)(2).Row
Range("R" & lgn) = Cells(lnS + 1, c.Column - 1)
Range("S" & lgn) = Cells(c.Row, c.Column - 1)
Range("T" & lgn) = Cells(lnS, 2)
Set c = .FindNext(c)
If c Is Nothing Then
GoTo fin
End If
Loop While Not c Is Nothing And c.Address <> adrD
End If
End With
ElseIf Target.Address = "$B$1" Then
For i = 1 To 8
nb = Choose(i, 2, 2, 40, 78, 116, 154, 192, 230)
jS = Choose(i, "Tout", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
If Target = jS Then Exit For
Next i
ActiveWindow.ScrollRow = nb - 1
Exit Sub
Else
Exit Sub
End If
fin:
Range("Q17").Select
Application.EnableEvents = True
End Sub
Sub Evenement()
Application.EnableEvents = True
End Sub