Code VBA qui ne fonctionne pas si filtre auto activé

Bonjour à tous,

J'ai un fichier en PJ avec un code VBA, réalisé par GMB qui fonctionne parfaitement (merci à lui) si pas de filtre auto activé.

Le code s'active quand l'onglet "Tableau" s'active.

Est'il possible que si l'onglet "Tableau" comporte des filtres auto activés, ca ne foire pas la fonction du code? du genre que ca ignore les filtres

Merci

Losand

Il faut enlever les filtres pour que cela marche

Option Explicit

Sub aa()

On Error Resume Next

ActiveSheet.ShowAllData

End Sub

Tout cela doit être sur le code de la FEUILLE filtrée

Et appeler cette sub avant le traitement

Cdt

Bonsoir

Juste avant la ligne dercol=..., mettez ceci -->

On error resume next
fT.ShowAllData

Une remarque sur la déclaration des variables. Je mettrais plutôt cela juste en dessous de "Private Sub Worksheet_Activate()"

Comme ceci :

Private Sub Worksheet_Activate()
Dim fI As Worksheet, fT As Worksheet, tabloT, tabloI, tabloR()
Dim it As Integer, ii As Integer, k As Integer, derln As Integer, dercol As Integer
Dim flag As Boolean
....

J'ai supprimé les variables i et j, qui ne servent pas

Cordialement

Bonjour

Attention à l'utilisation du

on error resume next 

Si on utilise ce genre d'instruction car on sait que cela risque d'engendré une erreur il ne faut pas oublier de desactivé cela pour la suite du code sinon en cas d'erreur plus tard dans l’exécution du code, le programme ne fera pas ce que l'on souhaite sans message d'erreur ...

donc ajouter ensuite :

On error goto 0

Sinon pour le sujet du jour moi j'utiliserais plutôt ceci pour désactivé les filtres :

If ActiveSheet.AutoFilterMode = True Then  ActiveSheet.AutoFilterMode = False

il faut évidemment être sur la feuille

Fred

Re

Exact Fred2406, c'est encore mieux comme cela.

Dans son code, cela peut devenir ceci -->

If ft.AutoFilterMode = True Then  ft.AutoFilterMode = False

Pour ce qui est d'être sur la feuille, il y sera puisque le code fonctionne à la sélection de l'onglet et le code se trouve placé dans cette feuille.

Cordialement

Bonsoir à tous,

merci de vos réponses, mais ma demande est différente.

Je souhaiterais que mon filtre reste activé et que le code fasse comme si ce n'était pas le cas.

je connais pas vraiment le VBA, Gmb m'a beaucoup aidé pour ce code mais si j'essaye d'exprimer ma demande je dirais :

Les variables Tablo ne peuvent t'elles pas ignorer le filtre et prendre en compte l'ensemble des lignes malgré le filtre.

Le filtre étant juste visuel pour l'utilisateur.

Losand

Bonjour

merci de vos réponses, mais ma demande est différente.

Je souhaiterais que mon filtre reste activé et que le code fasse comme si ce n'était pas le cas.

Je pense que vous n'avez pas essayé ce qui était proposé.

Remplacez le début du code par celui ci-dessous

Option Explicit
Private Sub Worksheet_Activate()
Dim fI As Worksheet, fT As Worksheet, tabloT, tabloI, tabloR()
Dim it As Integer, ii As Integer, k As Integer, derln As Integer, dercol As Integer
Dim flag As Boolean

    Set fI = Sheets("Import")               'On repére la feuille "Import" par une variable
    Set fT = Sheets("Tableau")              'On repère la feuille "Tableau" par une variable
    tabloI = fI.Range("A1").CurrentRegion   'On met les données du tableau de la feuille "Import" dans une variable tableau
    'tabloT = Range("A14").CurrentRegion      'On met les données du tableau de la feuille "Tableau" dans une variable tableau
    On Error Resume Next
    fT.ShowAllData
    On Error GoTo 0
dercol....

Veillez à supprimer les Dim qui se trouve juste en dessous de Option explicit puisqu'elles sont reprises dans le code que je vous propose

Cordialement

Bonjour Dan,

J'ai bien changé le code, mais je dois mal m'exprimer.

Je souhaite que mon tableau! reste filtré mais que le code ne soit pas perturbé par les filtres.

J'ai mis une explication en exemple sur le fichier en PJ.

En cherchant un peu, cela pourrait revenir à :

1- Memoriser les filtres actifs

2- Le filtrage se desactive

3- mon code s'execute

4- Le filtrage se reactive (avec les filtres mémorisés)

Losand

Bonjour,

Un essai ... Restriction d'un maximum de 2 paramètres de filtrage ...

Un sénior pourrait éventuellement améliorer pour avoir plus de 2 paramètres de filtrage ...

Option Explicit

Dim fI As Worksheet, fT As Worksheet, tabloT, tabloI, tabloR()
Dim i&, it&, ii&, j&, k&, derln&, dercol&, flag&
Dim filterArray()
Dim currentFiltRange As String

Private Sub Worksheet_Activate()

    Application.ScreenUpdating = False

    Set fI = Sheets("Import")               'On repére la feuille "Import" par une variable
    Set fT = Sheets("Tableau")              'On repère la feuille "Tableau" par une variable
    tabloI = fI.Range("A1").CurrentRegion   'On met les données du tableau de la feuille "Import" dans une variable tableau
    'tabloT = Range("A14").CurrentRegion      'On met les données du tableau de la feuille "Tableau" dans une variable tableau

    Call MemoriseFiltres

    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))
    ReDim tabloR(1 To UBound(tabloI, 1) - 1, 1 To UBound(tabloT, 2))    'On définit la variable tableau du résultat

    k = 0
    For ii = 3 To UBound(tabloI, 1)         'Om passe toutes les lignes de la variable tabloI
        flag = 0
        For it = 2 To UBound(tabloT, 1)     'pour chacune de ces lignes, on passe toutes les lignes de la variable tabloT
            If UCase(tabloT(it, 1)) = UCase(tabloI(ii, 1)) Then     'On recherche les lignes qui ont le même nom en colonne A
    'sur les 2 tableaux
                flag = 1                                'on indique qu'on en a trouvé une et
    'on recopie à la même ligne les données de la feuille Import
    'au cas ou une données ait changé sur les colonne B,C, ou D
                tabloT(it, 2) = tabloI(ii, 2)
                tabloT(it, 4) = Year(tabloI(ii, 3))
                tabloT(it, 6) = Month(tabloI(ii, 3))
                tabloT(it, 8) = tabloI(ii, 4)
            End If
        Next it

        If flag = 0 Then            'si flag = 0, aucune valeur en colonne A de tabloI ne corresopond
    'à une valeur de la colonne A de TabloT. C'est donc qu'il faut
    'ajouter la ligne du tabloI au tabloRon reporte dans tabloR les
    'nouvelles données de tabloI
            tabloR(k + 1, 1) = tabloI(ii, 1)
            tabloR(k + 1, 2) = tabloI(ii, 2)
            tabloR(k + 1, 4) = Year(tabloI(ii, 3))
            tabloR(k + 1, 6) = Month(tabloI(ii, 3))
            tabloR(k + 1, 8) = tabloI(ii, 4)
            k = k + 1
        End If
    Next ii

    'on reécrit le tabloT au bas du tableau de la feuille Tableau qui a pris en compte les lignes modifiées
    Range("A14").Resize(UBound(tabloT, 1), UBound(tabloT, 2)) = tabloT

    'on ajoute le tabloR (nouvelles lignes) au bas du tableau de la feuille Tableau
    Range("A" & UBound(tabloT, 1) + 14).Resize(UBound(tabloI, 1) - 1, UBound(tabloT, 2)) = tabloR

    'on classe les données du tableau de la feuille Tableau
    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))

    'With Range("A14").CurrentRegion
    With Range(Cells(14, 1), Cells(derln, dercol))
        .Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
    'et on y met le quadrillage
    'For i = 7 To 12
    '.Resize(Range("A14").CurrentRegion.Rows.Count, UBound(tabloR, 2)).Borders(i).LineStyle = xlContinuous
    'Next i
    End With

    Call ReAppliqueFiltres
End Sub

Sub MemoriseFiltres()  ''' kjin < de l'autre forum
Dim F As Integer

    Application.ScreenUpdating = False

    Set fT = ActiveSheet
    With fT.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For F = 1 To .Count
                With .Item(F)
                    If .On Then
                        filterArray(F, 1) = .Criteria1
                        If .Operator Then
                            filterArray(F, 2) = .Operator
                            filterArray(F, 3) = .Criteria2
                        End If
                    End If
                End With
            Next
        End With
    End With
    fT.AutoFilterMode = False      'suppression du filtre
End Sub

Sub ReAppliqueFiltres()   ''' kjin < de l'autre forum
Dim Col As Integer

    Application.ScreenUpdating = False

    fT.AutoFilterMode = False
    For Col = 1 To UBound(filterArray(), 1)
        If Not IsEmpty(filterArray(Col, 1)) Then
            If filterArray(Col, 2) Then
                fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1), _
                            Operator:=filterArray(Col, 2), Criteria2:=filterArray(Col, 3)
            Else
                fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1)
            End If
        End If
    Next
End Sub

ric

Merci Ric,

On s'approche du but mais il y a bug.

Lorsque tableau n'est pas filtré, je vais sur Import et revient sur Tableau, le filtre auto à disparu (plus de fleches grise)

et si je retourne sur import et revient encore sur tableau alors "Erreur d'execution 91"

Sinon ca fonctionne bien quand des filtres sont activés.

ric a écrit :

Bonjour,

Un essai ... Restriction d'un maximum de 2 paramètres de filtrage ...

Un sénior pourrait éventuellement améliorer pour avoir plus de 2 paramètres de filtrage ...

Option Explicit

Dim fI As Worksheet, fT As Worksheet, tabloT, tabloI, tabloR()
Dim i&, it&, ii&, j&, k&, derln&, dercol&, flag&
Dim filterArray()
Dim currentFiltRange As String

Private Sub Worksheet_Activate()

    Application.ScreenUpdating = False

    Set fI = Sheets("Import")               'On repére la feuille "Import" par une variable
    Set fT = Sheets("Tableau")              'On repère la feuille "Tableau" par une variable
    tabloI = fI.Range("A1").CurrentRegion   'On met les données du tableau de la feuille "Import" dans une variable tableau
    'tabloT = Range("A14").CurrentRegion      'On met les données du tableau de la feuille "Tableau" dans une variable tableau

    Call MemoriseFiltres

    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))
    ReDim tabloR(1 To UBound(tabloI, 1) - 1, 1 To UBound(tabloT, 2))    'On définit la variable tableau du résultat

    k = 0
    For ii = 3 To UBound(tabloI, 1)         'Om passe toutes les lignes de la variable tabloI
        flag = 0
        For it = 2 To UBound(tabloT, 1)     'pour chacune de ces lignes, on passe toutes les lignes de la variable tabloT
            If UCase(tabloT(it, 1)) = UCase(tabloI(ii, 1)) Then     'On recherche les lignes qui ont le même nom en colonne A
    'sur les 2 tableaux
                flag = 1                                'on indique qu'on en a trouvé une et
    'on recopie à la même ligne les données de la feuille Import
    'au cas ou une données ait changé sur les colonne B,C, ou D
                tabloT(it, 2) = tabloI(ii, 2)
                tabloT(it, 4) = Year(tabloI(ii, 3))
                tabloT(it, 6) = Month(tabloI(ii, 3))
                tabloT(it, 8) = tabloI(ii, 4)
            End If
        Next it

        If flag = 0 Then            'si flag = 0, aucune valeur en colonne A de tabloI ne corresopond
    'à une valeur de la colonne A de TabloT. C'est donc qu'il faut
    'ajouter la ligne du tabloI au tabloRon reporte dans tabloR les
    'nouvelles données de tabloI
            tabloR(k + 1, 1) = tabloI(ii, 1)
            tabloR(k + 1, 2) = tabloI(ii, 2)
            tabloR(k + 1, 4) = Year(tabloI(ii, 3))
            tabloR(k + 1, 6) = Month(tabloI(ii, 3))
            tabloR(k + 1, 8) = tabloI(ii, 4)
            k = k + 1
        End If
    Next ii

    'on reécrit le tabloT au bas du tableau de la feuille Tableau qui a pris en compte les lignes modifiées
    Range("A14").Resize(UBound(tabloT, 1), UBound(tabloT, 2)) = tabloT

    'on ajoute le tabloR (nouvelles lignes) au bas du tableau de la feuille Tableau
    Range("A" & UBound(tabloT, 1) + 14).Resize(UBound(tabloI, 1) - 1, UBound(tabloT, 2)) = tabloR

    'on classe les données du tableau de la feuille Tableau
    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))

    'With Range("A14").CurrentRegion
    With Range(Cells(14, 1), Cells(derln, dercol))
        .Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
    'et on y met le quadrillage
    'For i = 7 To 12
    '.Resize(Range("A14").CurrentRegion.Rows.Count, UBound(tabloR, 2)).Borders(i).LineStyle = xlContinuous
    'Next i
    End With

    Call ReAppliqueFiltres
End Sub

Sub MemoriseFiltres()  ''' kjin < de l'autre forum
Dim F As Integer

    Application.ScreenUpdating = False

    Set fT = ActiveSheet
    With fT.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For F = 1 To .Count
                With .Item(F)
                    If .On Then
                        filterArray(F, 1) = .Criteria1
                        If .Operator Then
                            filterArray(F, 2) = .Operator
                            filterArray(F, 3) = .Criteria2
                        End If
                    End If
                End With
            Next
        End With
    End With
    fT.AutoFilterMode = False      'suppression du filtre
End Sub

Sub ReAppliqueFiltres()   ''' kjin < de l'autre forum
Dim Col As Integer

    Application.ScreenUpdating = False

    fT.AutoFilterMode = False
    For Col = 1 To UBound(filterArray(), 1)
        If Not IsEmpty(filterArray(Col, 1)) Then
            If filterArray(Col, 2) Then
                fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1), _
                            Operator:=filterArray(Col, 2), Criteria2:=filterArray(Col, 3)
            Else
                fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1)
            End If
        End If
    Next
End Sub

ric

Bonjour à tous,

Je n'ai pas explorer ce cas de figure.

Je regarde la chose ...

ric

Bonjour à tous,

Un essai ... qui, je crois, répond à la demande ... et coquille corrigée ...

Option Explicit

Dim fI As Worksheet, fT As Worksheet, tabloT, tabloI, tabloR()
Dim i&, it&, ii&, j&, k&, derln&, dercol&, flag&
Dim filterArray()
Dim currentFiltRange As String
Dim Af As Boolean, AfActif As Boolean

Private Sub Worksheet_Activate()

    Application.ScreenUpdating = False
    Set fI = Sheets("Import")               'On repére la feuille "Import" par une variable
    Set fT = Sheets("Tableau")              'On repère la feuille "Tableau" par une variable
    tabloI = fI.Range("A1").CurrentRegion   'On met les données du tableau de la feuille "Import" dans une variable tableau

    With fT.AutoFilter
        If Not AutoFilter Is Nothing Then
            Call MemoriseFiltres
            Af = True
        Else
            Af = False
        End If
    End With

    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))
    ReDim tabloR(1 To UBound(tabloI, 1) - 1, 1 To UBound(tabloT, 2))    'On définit la variable tableau du résultat

    k = 0
    For ii = 3 To UBound(tabloI, 1)         'Om passe toutes les lignes de la variable tabloI
        flag = 0
        For it = 2 To UBound(tabloT, 1)     'pour chacune de ces lignes, on passe toutes les lignes de la variable tabloT
            If UCase(tabloT(it, 1)) = UCase(tabloI(ii, 1)) Then     'On recherche les lignes qui ont le même nom en colonne A
    'sur les 2 tableaux
                flag = 1                                'on indique qu'on en a trouvé une et
    'on recopie à la même ligne les données de la feuille Import
    'au cas ou une données ait changé sur les colonne B,C, ou D
                tabloT(it, 2) = tabloI(ii, 2)
                tabloT(it, 4) = Year(tabloI(ii, 3))
                tabloT(it, 6) = Month(tabloI(ii, 3))
                tabloT(it, 8) = tabloI(ii, 4)
            End If
        Next it

        If flag = 0 Then            'si flag = 0, aucune valeur en colonne A de tabloI ne corresopond
    'à une valeur de la colonne A de TabloT. C'est donc qu'il faut
    'ajouter la ligne du tabloI au tabloRon reporte dans tabloR les
    'nouvelles données de tabloI
            tabloR(k + 1, 1) = tabloI(ii, 1)
            tabloR(k + 1, 2) = tabloI(ii, 2)
            tabloR(k + 1, 4) = Year(tabloI(ii, 3))
            tabloR(k + 1, 6) = Month(tabloI(ii, 3))
            tabloR(k + 1, 8) = tabloI(ii, 4)
            k = k + 1
        End If
    Next ii

    'on reécrit le tabloT au bas du tableau de la feuille Tableau qui a pris en compte les lignes modifiées
    Range("A14").Resize(UBound(tabloT, 1), UBound(tabloT, 2)) = tabloT

    'on ajoute le tabloR (nouvelles lignes) au bas du tableau de la feuille Tableau
    Range("A" & UBound(tabloT, 1) + 14).Resize(UBound(tabloI, 1) - 1, UBound(tabloT, 2)) = tabloR

    'on classe les données du tableau de la feuille Tableau
    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))

    'With Range("A14").CurrentRegion
    With Range(Cells(14, 1), Cells(derln, dercol))
        .Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
    'et on y met le quadrillage
    'For i = 7 To 12
    '.Resize(Range("A14").CurrentRegion.Rows.Count, UBound(tabloR, 2)).Borders(i).LineStyle = xlContinuous
    'Next i
    End With

    If Af = True Then Call ReAppliqueFiltres
End Sub

Sub MemoriseFiltres()
Dim F As Integer

    Application.ScreenUpdating = False
    AfActif = False

    Set fT = ActiveSheet
    With fT.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For F = 1 To .Count
                With .Item(F)
                    If .On Then
                        AfActif = True
                        filterArray(F, 1) = .Criteria1
                        If .Operator Then
                            filterArray(F, 2) = .Operator
                            filterArray(F, 3) = .Criteria2
                        End If
                    End If
                End With
            Next
        End With
    End With
    fT.AutoFilterMode = False      'suppression du filtre
End Sub

Sub ReAppliqueFiltres()
Dim Col As Integer

    Application.ScreenUpdating = False
    fT.AutoFilterMode = False
    If AfActif = True Then
        For Col = 1 To UBound(filterArray(), 1)
            If Not IsEmpty(filterArray(Col, 1)) Then
                If filterArray(Col, 2) Then
                    fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1), _
                                  Operator:=filterArray(Col, 2), Criteria2:=filterArray(Col, 3)
                Else
                    fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1)
                End If
            End If
        Next Col
    End If
    If Af = True And AfActif = False Then
        With fT.AutoFilter
            On Error Resume Next
            fT.Range("A14:" & dercol & "14").Select
            Selection.AutoFilter = True
            On Error GoTo 0
        End With
    End If
End Sub

ric

Ric,

Malheureusement si pas de filtre, les fleches disparaissent toujours.

Mais plus de message d'erreur

ric a écrit :

Bonjour à tous,

Un essai ... qui, je crois, répond à la demande...

Option Explicit

Dim fI As Worksheet, fT As Worksheet, tabloT, tabloI, tabloR()
Dim i&, it&, ii&, j&, k&, derln&, dercol&, flag&
Dim filterArray()
Dim currentFiltRange As String
Dim Af As Boolean, AfActif As Boolean

Private Sub Worksheet_Activate()

    Application.ScreenUpdating = False

    Set fI = Sheets("Import")               'On repére la feuille "Import" par une variable
    Set fT = Sheets("Tableau")              'On repère la feuille "Tableau" par une variable
    tabloI = fI.Range("A1").CurrentRegion   'On met les données du tableau de la feuille "Import" dans une variable tableau

    With fT.AutoFilter
        If Not AutoFilter Is Nothing Then
            Call MemoriseFiltres
            Af = True
        Else
            Af = False
        End If
    End With

    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))
    ReDim tabloR(1 To UBound(tabloI, 1) - 1, 1 To UBound(tabloT, 2))    'On définit la variable tableau du résultat

    k = 0
    For ii = 3 To UBound(tabloI, 1)         'Om passe toutes les lignes de la variable tabloI
        flag = 0
        For it = 2 To UBound(tabloT, 1)     'pour chacune de ces lignes, on passe toutes les lignes de la variable tabloT
            If UCase(tabloT(it, 1)) = UCase(tabloI(ii, 1)) Then     'On recherche les lignes qui ont le même nom en colonne A
    'sur les 2 tableaux
                flag = 1                                'on indique qu'on en a trouvé une et
    'on recopie à la même ligne les données de la feuille Import
    'au cas ou une données ait changé sur les colonne B,C, ou D
                tabloT(it, 2) = tabloI(ii, 2)
                tabloT(it, 4) = Year(tabloI(ii, 3))
                tabloT(it, 6) = Month(tabloI(ii, 3))
                tabloT(it, 8) = tabloI(ii, 4)
            End If
        Next it

        If flag = 0 Then            'si flag = 0, aucune valeur en colonne A de tabloI ne corresopond
    'à une valeur de la colonne A de TabloT. C'est donc qu'il faut
    'ajouter la ligne du tabloI au tabloRon reporte dans tabloR les
    'nouvelles données de tabloI
            tabloR(k + 1, 1) = tabloI(ii, 1)
            tabloR(k + 1, 2) = tabloI(ii, 2)
            tabloR(k + 1, 4) = Year(tabloI(ii, 3))
            tabloR(k + 1, 6) = Month(tabloI(ii, 3))
            tabloR(k + 1, 8) = tabloI(ii, 4)
            k = k + 1
        End If
    Next ii

    'on reécrit le tabloT au bas du tableau de la feuille Tableau qui a pris en compte les lignes modifiées
    Range("A14").Resize(UBound(tabloT, 1), UBound(tabloT, 2)) = tabloT

    'on ajoute le tabloR (nouvelles lignes) au bas du tableau de la feuille Tableau
    Range("A" & UBound(tabloT, 1) + 14).Resize(UBound(tabloI, 1) - 1, UBound(tabloT, 2)) = tabloR

    'on classe les données du tableau de la feuille Tableau
    dercol = Cells(14, Columns.Count).End(xlToLeft).Column  'dernière colonne de la ligne 14
    derln = Range("A" & Rows.Count).End(xlUp).Row           'dernière ligne de la colonne A
    tabloT = Range(Cells(14, 1), Cells(derln, dercol))

    'With Range("A14").CurrentRegion
    With Range(Cells(14, 1), Cells(derln, dercol))
        .Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
    'et on y met le quadrillage
    'For i = 7 To 12
    '.Resize(Range("A14").CurrentRegion.Rows.Count, UBound(tabloR, 2)).Borders(i).LineStyle = xlContinuous
    'Next i
    End With

    If Af = True Then Call ReAppliqueFiltres
End Sub

Sub MemoriseFiltres()
Dim F As Integer

    Application.ScreenUpdating = False

    Set fT = ActiveSheet
    With fT.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For F = 1 To .Count
                With .Item(F)
                    If .On Then
                        AfActif = True
                        filterArray(F, 1) = .Criteria1
                        If .Operator Then
                            filterArray(F, 2) = .Operator
                            filterArray(F, 3) = .Criteria2
                        End If
                    End If
                End With
            Next
        End With
    End With

    fT.AutoFilterMode = False      'suppression du filtre
End Sub

Sub ReAppliqueFiltres()
Dim Col As Integer

    Application.ScreenUpdating = False

    fT.AutoFilterMode = False
    If AfActif = True Then
        For Col = 1 To UBound(filterArray(), 1)
            If Not IsEmpty(filterArray(Col, 1)) Then
                If filterArray(Col, 2) Then
                    fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1), _
                                  Operator:=filterArray(Col, 2), Criteria2:=filterArray(Col, 3)
                Else
                    fT.Range(currentFiltRange).AutoFilter field:=Col, Criteria1:=filterArray(Col, 1)
                End If
            End If
        Next Col
    End If
    If Af = False And AfActif = False Then
        With fT.AutoFilter
            On Error Resume Next
            fT.Range("A14:" & dercol & "14").Select
            Selection.AutoFilter = True
            On Error GoTo 0
        End With
    End If
End Sub

ric

Bonjour,

Désolé pour les coquilles ...

Mieux testé ...

Ça semble bien fonctionner ...

J'ai corrigé le code de mon post précédent ...

https://forum.excel-pratique.com/viewtopic.php?p=872956#p872956

ric

Bonjour Ric,

J'ai copié ton code corrigé (en PJ) mais les flèches grises du filtre auto disparaissent toujours.

Losand

ric a écrit :

Bonjour,

Désolé pour les coquilles ...

Mieux testé ...

Ça semble bien fonctionner ...

J'ai corrigé le code de mon post précédent ...

https://forum.excel-pratique.com/viewtopic.php?p=872956#p872956

ric

Bonjour,

Je constate que ... si j'enlève le filtre et que je le remets ... le premier coup ça fonctionne, mais plus par la suite ...

Désolé ...

Je vais tenter de trouver un solution ...

ric

Bonjour,

Enfin ... une solution qui semble durable ...

J'ai constaté que si la cellule active de la feuille "Tableau" est dans la plage de tes données filtrées (une cellule non vide), le filtre revient actif.

Si la cellule active est en dehors de la plage des données filtrées, le filtre ne se réapplique pas.

L'explication est simple ... en VBA, l'on ne peut pas activer un filtre si la cellule active n'est pas dans la plage à filtrer. Je propose de ne sélectionner qu'une seule cellule et idéalement dans l'en-tête.

Je suggère donc ....

Sub ReAppliqueFiltres()
Dim Col As Integer

    Application.ScreenUpdating = False
    Cells(14, "A").Select   ' << une cellule quelconque dans la plage des données filtrées
    fT.AutoFilterMode = False
    ...
    ...
    ...

ric

Bonsoir Ric,

Merci beaucoup, la solution ne me convient pas mais la précision de tes explications m'à permis de contourner le problème.

En effet, dans mon fichier final, le code sera actif lors de la sélection d'une cellule afin d’être dynamique (et pas en sélectionnant la feuille)

Je te remercie pour ton aide précieuse

Résolu

Losand

ric a écrit :

Bonjour,

Enfin ... une solution qui semble durable ...

J'ai constaté que si la cellule active de la feuille "Tableau" est dans la plage de tes données filtrées (une cellule non vide), le filtre revient actif.

Si la cellule active est en dehors de la plage des données filtrées, le filtre ne se réapplique pas.

L'explication est simple ... en VBA, l'on ne peut pas activer un filtre si la cellule active n'est pas dans la plage à filtrer. Je propose de ne sélectionner qu'une seule cellule et idéalement dans l'en-tête.

Je suggère donc ....

Sub ReAppliqueFiltres()
Dim Col As Integer

    Application.ScreenUpdating = False
    Cells(14, "A").Select   ' << une cellule quelconque dans la plage des données filtrées
    fT.AutoFilterMode = False
    ...
    ...
    ...

ric