Effectuer un tri une fois un nombre de cellules complété

Bonjour,

Je voudrais trier mes lignes de A19 à U218 (tableau de données) une fois que les cellules de A à R de la ligne active sont complétées, le critère de tri est la cellule active de la colonne A.

Si je pousse plus loin le sujet, l'idéal serait d'avoir un tri dès lors que les cellules de la ligne active de A à R soit complétées, même si la dernière cellule complétée est la cellule C par exemple.

Voici mon code actuel, le problème vient de la ligne bleue, mon code ne se lance pas car la cellule R correspond au résultat d'un calcul, donc une formule protégée, et il s'avère que si je ne clique pas sur la cellule R, le tri ne se réalise pas.

Merci pour votre support !

Cordialement :)

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Static EnCours As Boolean 'Evite l'effet de boucle sur l'évènement Change()
If EnCours Then Exit Sub
If Not Application.Intersect(Target, Range("R:R")) Is Nothing Then
On Error Resume Next
ActiveSheet.Unprotect Password:="CPV"
ActiveSheet.Unprotect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
EnCours = True
Range("A19:U218").Sort Key1:=Range("A19"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
EnCours = False
ActiveSheet.Protect Password:="CPV", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End If
Application.EnableEvents = True
End Sub

Hello,

J'ai pas tout compris , mais un évènement change avec cette ligne :

If Not Application.Intersect(Target, Range("R:R")) Is Nothing Then

ne porte pas sur la cellule R mais sur la colonne entière

Salut Arkadia,
Salut Rag,

SSI la formule en [R:R] dépend d'une ou l'autre des valeurs en [A:Q] alors ceci devrait convenir.
Si le compte des valeurs non vides en [A:Q] = 17, le tri s'opère.
Ton tri s'opère entre [A19:U218] avec la Key1:= [A19] : il n'y a donc pas d'en-têtes à exclure du tri -> Header:= xlNo

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If WorksheetFunction.CountA(Range("A" & Target.Row & ":Q" & Target.Row)) = 17 Then _
    ActiveSheet.Unprotect Password:="CPV", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True: _
    Range("A19:U218").Sort Key1:=Range("A19"), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes: _
    ActiveSheet.Protect Password:="CPV", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Encore une fois, sans fichier...

A+

Hello,

Merci pour vos retours, le fichier est confidentiel, je ne peux pas le partager...Par contre vu ton code, tu as compris mon besoin. Je suis au début parti sur un code similaire au tiens, de comptage de colonnes (dès que j'ai 17 cellules complétées je trie). Bon mon code ne faisait rien du tout (sûrement une erreur de synthaxe).

Ici quand j'essaye d'activer la macro j'ai une erreur de type 1004 ^^" (je n'ai aucun skill pour comprendre l'erreur).

Merci !

Salut Arkadia,

ça, mon ami... aucune idée : jamais, ou presque, joué avec les Protect !

Essaie simplement ??

ActiveSheet.Unprotect Password:="CPV"

A+

Re,

Alors j'ai réussi à combiner les deux codes, ça donne ceci et ça marche :) ! Merci !

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
Static EnCours As Boolean
If EnCours Then Exit Sub
If WorksheetFunction.CountA(Range("A" & Target.Row, "Q" & Target.Row)) = 17 Then
On Error Resume Next
ActiveSheet.Unprotect Password:="CPV"
ActiveSheet.Unprotect , DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
EnCours = True
Range("A19:U218").Sort Key1:=Range("A19"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
EnCours = False
Sheets("Tableau de saisie").Protect Password:="CPV", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Salut Arkadia,

pour le fun et tester, mets cette ligne en commentaire...

On Error Resume Next

Curieux de voir l'effet...

A+

Hello,

Désolé pour la réponse tardive, en enlevant la ligne le code bug erreur 1004.

Cordialement !