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
| Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n&, j&, ln%, i%, k%, conseil, tablo()
If Not Intersect(Target, Me.Range("q28:q" & ln)) Is Nothing Then
manager = "alain.dupont"
date_du_jour = Format(Now, "dd/mm/yyyy")
If Target.Row = ln Then
For i = 28 To ln - 1
conseil = conseil & ";" & Me.Cells(i, 1)
Next i
Else
conseil = ";" & Me.Range("A" & Target.Row)
End If
conseil = Split(conseil, ";")
With Worksheets("Stock Activités")
n = .Range("L" & .Rows.Count).End(xlUp).Row
For j = 3 To n
If .Cells(j, 15) = manager And .Cells(j, 14) < date_du_jour Then
For i = 1 To UBound(conseil)
If .Cells(j, 11) = conseil(i) Then Exit For
Next i
If i <= UBound(conseil) Then
k = k + 1: ReDim Preserve tablo(2 To 14, 1 To k)
For i = 2 To 14
tablo(i, k) = .Cells(j, i)
Next i
End If
End If
Next j
End With
With Worksheets("Liste Activités")
.Range("B2").Resize(k, 13).Value = WorksheetFunction.Transpose(tablo)
.Visible = xlSheetVisible
.Activate
End With
End If
End Sub |
Partager