Revue de code VBA - problème affichage filtre

Bonjour,

Je suis sur la finalisation de mon code pour un fichier de gestion de charge.

Voici le code (looooong ^^"):

Public nombredelignes As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
 If nombredelignes < ActiveSheet.ListObjects("Tableau1").ListRows.Count Then 'Permet d'ajouter initiation à chaque insertion de ligne
        nombredelignes = ActiveSheet.ListObjects("Tableau1").ListRows.Count
        For Each r In Target.Rows
            Cells(r.Row, "C") = "INITIATION"
        Next
    Else
        If nombredelignes > ActiveSheet.ListObjects("Tableau1").ListRows.Count Then 'Permet de confirmer la suppression de la ligne
                    nombredelignes = ActiveSheet.ListObjects("Tableau1").ListRows.Count
            If MsgBox("Etes-vous sûr de vouloir supprimer la ligne ?" & vbCrLf & "Attention toute validation est définitive, aucune re-modification de la ligne ne sera possible !", vbInformation + vbYesNo) = vbYes Then
            Else
                Application.Undo
            End If
        End If
    End If
           Static EnCours As Boolean 'Permet de trier le Tableau1 par les colonnes D, A et B si A/B/D/E/F remplies - déprotection de la feuille
    If EnCours Then Exit Sub
    On Error Resume Next
    If WorksheetFunction.CountA(Union(Range("A" & Target.Row), Range("B" & Target.Row), Range("D" & Target.Row), Range("E" & Target.Row), Range("F" & Target.Row))) = 5 Then
        ActiveSheet.Unprotect Password:="XXXXX"
ActiveSheet.Unprotect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True, AllowDeletingRows:=True, AllowInsertingRows:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
            Application.ScreenUpdating = False
        EnCours = True
          Range("Tableau1").Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("A3"), Order2:=xlAscending, Key3:=Range("B3"), Order3:=xlAscending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
            EnCours = False

            'Permet de trier le tableau de charge par la couleur = tableau reste toujours en bas
ActiveSheet.ListObjects("Tableau1").Sort.SortFields. _
        Add(Range("Tableau1[NOM COLONNE]"), xlSortOnCellColor, xlDescending, , _
        xlSortNormal).SortOnValue.Color = RGB(146, 205, 220)
    With ActiveSheet.ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With
            ActiveWorkbook.Worksheets("NOM FEUILLE").ListObjects("Tableau1").Sort.SortFields. _
        Clear
    With ActiveWorkbook.Worksheets("NOM FEUILLE").ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A3:BZ500").EntireRow.AutoFit 'Permet de réaliser un autofit sur toutes les lignes + reprotection de la feuille
 ActiveSheet.Protect Password:="XXXXX", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowDeletingRows:=True, AllowInsertingRows:=True, AllowFormattingColumns:=False, AllowFormattingRows:=False
End If
 Application.ScreenUpdating = True
 Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
nombredelignes = ActiveSheet.ListObjects("Tableau1").ListRows.Count
'Permet d'interdire le copier/coller dans les colonnes A:F
   If Not Intersect(Target, Range("A:F")) _
     Is Nothing Then
        Application.CutCopyMode = False
        NoCopCol = True
   Else
        If NoCopCol Then Application.CutCopyMode = False
        NoCopCol = False
    End If
End Sub

Le code fonctionne, du moins toutes les fonctionnalités attendues (j'ai découpé les différentes parties au grès de posts sur le forum). Je pense que je tiens le bon bout ! Alors il y a sûrement des choses à simplifier et je suis preneur si jamais.

Le dernier problème que j'ai est la fonction filtre du tableau, pour je ne sais quelle raison, dès fois (pas systématique donc), quand je filtre sur la colonne D, j'ai bien mon filtre qui fonctionne mais quand je rajoute une ligne + je remplis les cellules permettant le tri (condition: A/B/D/E/F remplies), le filtre se reset au lieu de rester sur la valeur sélectionnée de la colonne D. Et d'autres fois je fais exactement la même manip, mais c'est en remplissant une cellule dans la table de charge (de la colonne G à AX), que le filtre reset.

Vous avez des coms dans le code pour comprendre chaque action.

Si vous avez une solution je suis preneur :D !

Merci beaucoup !

Cordialement !

Ok j'ai compris l'enchaînement d'évènement qui provoque le reset du filtre (j'essaye d'être le plus clair possible :) ).

Je sélectionne une variable à filtrer dans la colonne D et j'active le code macro

Si je décide de changer de variable D, le filtre reset toujours (et j'ai au visuel la flèche de filtre active, alors que toutes mes variables sont visibles car filtre rest).

Pour revenir à la normale, je dois resélectionner toutes les variables dans le filtre (= choix sélectionner tous), sortir du filtre = reset de la flèche de filtre et resélectionner la variable que je veux filtrer = flèche de filtre revenue.

Rechercher des sujets similaires à "revue code vba probleme affichage filtre"