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

chris4785478547 · 13 Décembre 2020

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

Phil69970 · 13 Décembre 2020

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

Phil69970 · 13 Décembre 2020

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

chris4785478547 · 13 Décembre 2020

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

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

chris4785478547

XLDnaute Junior

Phil69970

Phil69970

XLDnaute Barbatruc

chris4785478547

XLDnaute Junior

Discussions similaires