XL 2016 VBA-Filtre Avancé

[Dureux]

Bonjour,

Me revoilà avec encore un petit problème. Je travaille toujours sur la création d'un échéancier qui bascule sur un tableau de relance.
J'ai donc une Macro qui me permet de filtrer dans mes feuilles échéancier les personnes où régler=Non et aussi de les trier selon le numéro de client.
Le problème de ma Macro est le suivant : Les colonnes "Acompte" et "Commentaires" où l'utilisateur peut inscrire des données se modifie quand on lance la Macro en faisant remonter les cellules.

Je vous joins à cela mon Fichier, il suffit de faire CTRL+R pour lancer la Macro qui permet de basculer sur la Relance.
Les données du tableau sont purement fictive et servent d'exemple.
Voici aussi un descriptifs des différentes feuilles de l'échéancier afin de mieux le comprendre :

- Tout d'abords mes feuilles échéancier ( Ici elles vont jusqu'au mois de mai, mais dans le dossier finale elles iront jusqu'au mois de décembre. ) Elles fonctionnent avec la base de données des Factures et des Clients, et donc s'automatisent selon le numéro des Factures. Et l'utilisateur inscrit si oui ou non il a réglée à l'aide de la liste déroulante dont j'ai inscrit mes données dans ma feuille "Annexe"
Pour les échéanciers j'ai créé 2 Macros, la première permet de Filtrer l'échéancier si Réglée=Non et la deuxième permet de faire un retour après le filtre.
- Ensuite, ma feuille de Relance. Celle ci me permet donc de regrouper tout les "réglée=Non" sur une même feuille afin de suivre la relance du Client. Afin de suivre au mieux la relance il y a les colonnes de "H à L" que j'ai automatisé afin de rechercher dans ma base de données le numéro de téléphone et l'email, mais aussi le reste à payer selon que le client est verser un acompte ou non et aussi les commentaires que l'utilisateur peut rajouter.
Et j'avais aussi inscrit un En-tête pour ma feuille de relance mais la Macro refuse de fonctionner avec celui-ci, je vous ai donc rajouter une feuille que j'ai nommer "RelanceEntête" où vous pouvez voir mon tableau initial avec l'entête.

Sub FILTREAVANCE3()

Dim critere As Range, w As Worksheet, titres As Range
Set critere = Sheets("Annexe").[A1:A2]
Application.ScreenUpdating = False
With Feuil6.[A:G]  'feuille Relance
    .Rows(2).Resize(.Rows.Count - 1).ClearContents 'RAZ
    Range("A2").Select
   
    For Each w In Worksheets
        If w.Name Like "0*" Then

            Set titres = .Cells(.Rows.Count, 1).End(xlUp)(2).Resize(, .Columns.Count)
            .Rows(1).Copy titres
            w.Range("A7").CurrentRegion.AdvancedFilter xlFilterCopy, critere, titres
            titres.EntireRow.Activate
            titres.EntireRow.Delete xlUp
            Do While ActiveCell.Value <> ""
                Range("A" & (ActiveCell.Row + 1)).Select
            Loop
            With ActiveCell
                 .EntireRow.Insert xlShiftDown 'Insert une ligne au dessus
                 .EntireRow.Copy ' Copie la ligne active
                 With .Offset(-1).EntireRow 'Passe les formats et formules à la ligne insérée
                    .PasteSpecial xlPasteFormats
                    .PasteSpecial xlPasteFormulas
                    End With
                Application.CutCopyMode = False
            End With
        End If
    Next
End With

'
' Triage Macro
' Triage selon num client- relance
'

'
    Cells.Select
    ActiveWorkbook.Worksheets("Relance").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Relance").Sort.SortFields.Add Key:=Range("A2:A119" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Relance").Sort
        .SetRange Range("A1:L119")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
End Sub

Merci d'avance pour votre aide

 

[Bebere]

bonjour
Dureux bienvenue
un code sans filtre,plus facile

Sub ReglerNon()
    Dim a(), i As Long, L As Long, cel As Range,w as Worksheet
    ' ReglerNon Macro
    ' Trie l'échéancier selon que régler = Non
    Feuil10.Range("A8:F200").ClearContents
    For Each w In Worksheets
        If IsNumeric(Left(w.Name, 2)) Then
            L = w.Range("A65000").End(xlUp).Row
            If L > 7 Then
                For Each cel In w.Range("G8:G" & L)
                    If cel = "Non" Then
                        i = i + 1: ReDim Preserve a(1 To 6, 1 To i)
                        a(1, i) = cel.Offset(, -2)
                        a(2, i) = cel.Offset(, -1)
                        a(3, i) = cel.Offset(, -6)
                        a(4, i) = cel.Offset(, -5)
                        a(5, i) = cel.Offset(, -4)
                        a(6, i) = cel.Offset(, -3)
                    End If
                Next
            End If
        End If
    Next
    a = Application.Transpose(a)
    Feuil10.Range("A8").Resize(UBound(a, 1), UBound(a, 2)) = a

End Sub

 

[Dureux]

Bonjour Bebere,

Merci beaucoup, de cette manière je peux même garder mon en-tête !
J'espère pouvoir le retranscrire aux mieux pour mon dossier finale.

EDIT : Je vais essayer de rajouter afin que cela ce trie selon le numéro de client aussi

 

[Bebere]

bonsoir
Dureux code avec commentaire ajout de tri
pour consulter l'aide touche F1 pour appel ,le curseur sur mot clé(exemple ubound)

 

[Dureux]

Bonjour Bebere,
Tout d'abord merci pour ton explication et ton aide, malgré tout la même erreur persiste, et du coup je remarque que c'est à cause du triage fait par le numéro des clients... Quand le Tri ce lance si il y a des données dans les colonnes de G à L celle-ci s'interposent se changent ect..
Afin de mieux observer le problème j'ai diviser les macros, une qui lance la relance et la 2éme pour le triage. Et on peut bien voir que c'est le Tri qui pose problème.

 

[Bebere]

bonjour
Dureux pas vu d'erreur après tri
corrigé le code du côté des dates et ajouté code pour formules

 

[Dureux]

Bonjour,
Je pense que sa ce passe uniquement au niveau des 2 première lignes, il faut relancer les macro 2 fois pour que sa se remette à l'identique.
En tout cas de cette façon c'est vraiment géniale. Un grand merci à toi

Cordialement.