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
| Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If bActiver = False Then Exit Sub
Dim n&, j&, ln%, i%, k%, conseil, etat$, tablo()
If Target.Cells(1, 1) = "" Or Target.Count > 1 Then Exit Sub
' si case vide pas de procédure
Set sh = Sheets("Liste Demandes")
sh.Range("B2").CurrentRegion.Offset(1).ClearContents
ln = Me.Range("A" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Me.Range("C5:h" & ln)) Is Nothing Then
etat = Me.Cells(4, Target.Column)
If Target.Row = ln Then
For i = 5 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 Demandes")
n = .Range("K" & .Rows.Count).End(xlUp).Row
For j = 3 To n
If .Cells(j, 6) = etat 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 13, 1 To k)
For i = 2 To 13
tablo(i, k) = .Cells(j, i)
Next i
End If
End If
Next j
End With
With Worksheets("Liste Demandes")
.Range("B2").Resize(k, 12).Value = WorksheetFunction.Transpose(tablo)
.Visible = xlSheetVisible
.Activate
End With
End If
End sub |
