Bonjour à tous,

J'utilise actuellement une macro pour effectuer un filtre auto à partir d'un tableau de résultat.

A ce jour tout fonctionne parfaitement.
Afin de faire évoluer mon reporting, je souhaite insérer un autre tableau en dessous du premier.

Le problème arrive alors puisque j'utilise cette partie de code qui n'est plus adaptée.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
ln = Me.Range("A" & Rows.Count).End(xlUp).Row
Du coup j'aurai voulu adapter cette partie non plus à toute les lignes mais uniquement jusqu'à une ligne déterminée (a savoir la ligne 22)

Je vous joint le code en entier ci dessous.

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
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 ou > 1 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, 12) = conseil(i) Then Exit For
                    Next i
                    If i <= UBound(conseil) Then
                        k = k + 1: ReDim Preserve tablo(2 To 15, 1 To k)
                        For i = 2 To 15
                            tablo(i, k) = .Cells(j, i)
                        Next i
                    End If
                End If
            Next j
        End With
        With Worksheets("Liste Demandes")
            .Range("B2").Resize(k, 14).Value = WorksheetFunction.Transpose(tablo)
            .Visible = xlSheetVisible
            .Activate
        End With
    End If
End sub
En espérant avoir été assez précise.
Sophie