XL 2019 Supprimer la 1000eme ligne et classer lignes par dates

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

chris4785478547

XLDnaute Junior
Bonjour le forum, (ou bonne nuit...je n'arrive pas à me résoudre à aller me coucher...)
Vu votre efficacité de l'autre jour je me dis que je ferais mieux de faire appel à vous car je vais y passer des semaines à ce train là.
Je souhaite que mon programme ne dépasse pas les 1000 lignes, donc, quand on rentre une date dans la 1001 eme ligne, je veux effacer la toute 1ere ligne et je fais un classement des lignes par dates pour remonter le tout (c'est tout ce que j'ai trouvé mais il y a peut être plus simple)
j'ai donc pour cela:
une macro pour supprimer la 1ere ligne (appellée "suppression_ligne")
et une macro pour classer les lignes par dates croissantes (appellée "classer_lignes")
C'est la macro "suppression-ligne" qui appelle la macro "classer_lignes"
Si je lance manuellement "suppression-ligne" tout se passe à merveille
mais je veux lancer le processus en auto lorsque j'arrive à la 1001 eme ligne (disons la 20 eme ligne pour les essais)
Et là, tout se bloque, c'est comme si j'avais une boucle sans fin qui finit par fermer Excel sans code d'erreur
J'ai essayé le mode debug sans comprendre ce qui se passe

Voici mon code feuille:
VB:
Private Sub Worksheet_Change(ByVal Target As range)

If range("A20") <> "" Then
    Call suppression_ligne
End If
End Sub

1ere macro:
VB:
Sub suppression_ligne()

    Dim mem
    mem = range("I6") - range("B7") + range("C7")
    range("A7:H7").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    range("I6") = mem
    Call classer_lignes
    
    range("A7").Select 
 End Sub

2eme macro:
VB:
Sub classer_lignes()

    range("A7:H1000").Select
    
    ActiveWorkbook.Worksheets("SAISIE COMPTES ").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SAISIE COMPTES ").Sort.SortFields.Add Key:=range( _
        "A7:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("SAISIE COMPTES ").Sort
        .SetRange range("A7:H1000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    range("A7").Select
    
End Sub

Voila, j'ai tâché d'être le plus précis possible pour vous donner tous les éléments nécessaires, je ne pense pas avoir oublié quelque chose...
Merci par avance.
Christian
 
Solution
Bonjour Chris

Je te propose ceci :
*Attention tu as un espace à la fin du nom de ta feuille risque de source de problème potentiel "SAISIE COMPTES "

VB:
Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1001")) Is Nothing Then
    If IsEmpty(Range("A1000")) Then Exit Sub
    SupLig
End If
End Sub


Sub SupLig()
Range("I6") = Range("I6") - Range("B7") + Range("C7")

Range("A7:H7").ClearContents

Worksheets("SAISIE COMPTES ").Range("A7:H1000").Sort Key1:=Range("A7"), Order1:=xlAscending, dataoption1:=xlSortNormal, Header:=xlNo
Range("A1000").Select
End Sub

@Phil69970
Bonjour Chris

Je te propose ceci :
*Attention tu as un espace à la fin du nom de ta feuille risque de source de problème potentiel "SAISIE COMPTES "

VB:
Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1001")) Is Nothing Then
    If IsEmpty(Range("A1000")) Then Exit Sub
    SupLig
End If
End Sub


Sub SupLig()
Range("I6") = Range("I6") - Range("B7") + Range("C7")

Range("A7:H7").ClearContents

Worksheets("SAISIE COMPTES ").Range("A7:H1000").Sort Key1:=Range("A7"), Order1:=xlAscending, dataoption1:=xlSortNormal, Header:=xlNo
Range("A1000").Select
End Sub

@Phil69970
 
Dernière édition:
Bonjour Phil
CA MARCHE ! un grand grand grand merci Phil pour ton aide précieuse !🙂
Je vais plancher tout de même pour comprendre ton code feuille
Bravo aussi pour l'extrême simplicité de ton code très épuré, j'avais apparemment un peu trop d'instructions.
Tu me fais surement gagner des jours de galère !😉
Excellent dimanche à toi.
Chris
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour