Effacer les données d'une ligne et retrier les données de la feuille

[degap05]

Bonjour,

Sur certaines feuilles de mon classeur et sur chaque ligne, à partir de la ligne 4, je renseigne des données de la cellule A à la cellule Z, qui est une cellule cible pour transférer les données de la ligne vers une autre feuille. J'aimerais que par cette action, le contenu des cellules la ligne soit effacée (mais pas les formules) et que l'ensemble des lignes de la feuille soient retriées, à partir de la ligne 4, sur la base d'un N° de lot (premier argument, ordre croissant) en colonne B et d'une date en colonne C (ordre croissant, second argument).

Merci de votre aide

[skoobi]

Bonjour,

Ta demande est incomplète je trouve.
Actuellement, le code copie de la feuille source vers la feuille « Données ».
Tu veux effacer les données de quelle(s) ligne(s) et trier quelle feuille ?.
Avec le fichier on y verrait aussi plus clair.

Bon après-midi.

[degap05]

Envoyé par skoobi

Bonjour,

Ta demande est incomplète je trouve.
Actuellement, le code copie de la feuille source vers la feuille « Données ».
Tu veux effacer les données de quelle(s) ligne(s) et trier quelle feuille ?.
Avec le fichier on y verrait aussi plus clair.

Bon après-midi.

Bonjour Skoobi, tu as raison cela manque de précision, alors dans l'ordre:

-actuellement, le code copie de la feuille source vers la feuille "Données" = OUI,

-je souhaite effacer les données de la ligne de la feuille source, correspondant à la cellule de la colonne 26 que je viens de renseigner, une fois celle-ci copiée ver la feuille "Données" . La ligne existe toujours, mais vide (avec les formules dans les cellules).

-je souhaite ensuite, trier ou réorganiser la feuille source afin de ne pas laisser de lignes vides au milieu d'autres enregistrements.

Merci.

[degap05]

Envoyé par degap05

Bonjour Skoobi, tu as raison cela manque de précision, alors dans l'ordre:

-actuellement, le code copie de la feuille source vers la feuille "Données" = OUI,

-je souhaite effacer les données de la ligne de la feuille source, correspondant à la cellule de la colonne 26 que je viens de renseigner, une fois celle-ci copiée ver la feuille "Données" . La ligne existe toujours, mais vide (avec les formules dans les cellules).

-je souhaite ensuite, trier ou réorganiser la feuille source afin de ne pas laisser de lignes vides au milieu d'autres enregistrements.

Merci.

Voici un classeur sommaire pour mieux m'expliquer.
Merci.

[skoobi]

Re,
pourquoi as-tu enlevé le code que tu as mis au début?
Il aurait à mon avis juste fallu l'adapter.
Pourrais-tu le remettre stp?

[degap05]

Envoyé par skoobi

Re,
pourquoi as-tu enlevé le code que tu as mis au début?
Il aurait à mon avis juste fallu l'adapter.
Pourrais-tu le remettre stp?

Bonjour, j'ai pensé que ce code ne servirait pas forcément et qu'il était encombrant, le voici:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Lig, derlig, num1 As Integer, Couleur As Long
Lig = Target.Row
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then GoTo suite
If Target.Column = 26 Then
With Sheets("Données")
.Visible = True
derlig = .Range("A65500").End(xlUp).Row + 1
.Cells(derlig, 2).Value = Cells(Lig, 2).Value
.Cells(derlig, 3).Value = Cells(Lig, 3).Value
.Cells(derlig, 4).Value = Cells(Lig, 10).Value
.Cells(derlig, 5).Value = Cells(Lig, 9).Value
.Cells(derlig, 6).Value = Cells(Lig, 12).Value
.Cells(derlig, 7).Value = Cells(Lig, 11).Value
.Cells(derlig, 8).Value = Cells(Lig, 20).Value
.Cells(derlig, 9).Value = Cells(Lig, 26).Value
.Cells(derlig, 10).Value = Cells(Lig, 8).Value
.Cells(derlig, 11).Value = Cells(Lig, 21).Value
.Cells(derlig, 12).Value = Cells(Lig, 22).Value
.Cells(derlig, 13).Value = Cells(Lig, 23).Value
.Cells(derlig, 14).Value = Cells(Lig, 24).Value
.Cells(derlig, 15).Value = Cells(Lig, 25).Value
.Cells(derlig, 1).Value = ActiveSheet.Name
num1 = .Cells(derlig - 1, 16).Value
.Cells(derlig, 16).Value = num1 + 1
End With

Merci

[skoobi]

Bonjour,

voici le code adapté pour l'exemple du fichier:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim Lig, derlig, num1 As Integer, Couleur As Long
Lig = Target.Row
If Target.Count > 1 And Target.Value = "" Then Exit Sub
If Target.Column = 26 Then
  With Sheets("Données")
    .Visible = True
    derlig = .Range("A65500").End(xlUp).Row + 1
    .Cells(derlig, 2).Value = Cells(Lig, 2).Value
    .Cells(derlig, 3).Value = Cells(Lig, 3).Value
    .Cells(derlig, 4).Value = Cells(Lig, 10).Value
    .Cells(derlig, 5).Value = Cells(Lig, 9).Value
    .Cells(derlig, 6).Value = Cells(Lig, 12).Value
    .Cells(derlig, 7).Value = Cells(Lig, 11).Value
    .Cells(derlig, 8).Value = Cells(Lig, 20).Value
    .Cells(derlig, 9).Value = Cells(Lig, 26).Value
    .Cells(derlig, 10).Value = Cells(Lig, 8).Value
    .Cells(derlig, 11).Value = Cells(Lig, 21).Value
    .Cells(derlig, 12).Value = Cells(Lig, 22).Value
    .Cells(derlig, 13).Value = Cells(Lig, 23).Value
    .Cells(derlig, 14).Value = Cells(Lig, 24).Value
    .Cells(derlig, 15).Value = Cells(Lig, 25).Value
    .Cells(derlig, 1).Value = ActiveSheet.Name
    num1 = .Cells(derlig - 1, 16).Value
    .Cells(derlig, 16).Value = num1 + 1
  End With
  Range("A" & Target.Row & ":Z" & Target.Row).SpecialCells(xlCellTypeConstants).Clear
  Range("A4", Cells([A4].End(xlDown).Row, Target.Column)).Sort Key1:=Range("B4"), Order1:=xlAscending, Key2:=Range( _
      "C4"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
      False, Orientation:=xlTopToBottom
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Bon week-end

[degap05]

Bonjour, Skoobi,

Sur mon fichier d'essai, il ne se passe rien, ni effacement ni tri

Je le re-joins, j'ai dû faire une erreur.

Sur mon fichier de travail, cela fonctionne partiellement. L'effacement des données se produit en gardant les formules, mais cela efface également les bordures (que je souhaiterais garder). Par contre, pas de tri de la plage de données A à X, la ligne reste à sa place, vide.

Merci.

[skoobi]

Re,

ça devrait aller mieux comme ça:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim Lig, derlig, num1 As Integer, Couleur As Long
Lig = Target.Row
If Target.Count > 1 And Target.Value = "" Then Exit Sub
If Target.Column = 26 Then
  With Sheets("Données")
    .Visible = True
    derlig = .Range("A65500").End(xlUp).Row + 1
    .Cells(derlig, 2).Value = Cells(Lig, 2).Value
    .Cells(derlig, 3).Value = Cells(Lig, 3).Value
    .Cells(derlig, 4).Value = Cells(Lig, 10).Value
    .Cells(derlig, 5).Value = Cells(Lig, 9).Value
    .Cells(derlig, 6).Value = Cells(Lig, 12).Value
    .Cells(derlig, 7).Value = Cells(Lig, 11).Value
    .Cells(derlig, 8).Value = Cells(Lig, 20).Value
    .Cells(derlig, 9).Value = Cells(Lig, 26).Value
    .Cells(derlig, 10).Value = Cells(Lig, 8).Value
    .Cells(derlig, 11).Value = Cells(Lig, 21).Value
    .Cells(derlig, 12).Value = Cells(Lig, 22).Value
    .Cells(derlig, 13).Value = Cells(Lig, 23).Value
    .Cells(derlig, 14).Value = Cells(Lig, 24).Value
    .Cells(derlig, 15).Value = Cells(Lig, 25).Value
    .Cells(derlig, 1).Value = ActiveSheet.Name
    num1 = .Cells(derlig - 1, 16).Value
    .Cells(derlig, 16).Value = num1 + 1
  End With
  derlig = [A4].End(xlDown).Row
  Range("A" & Target.Row & ":Z" & Target.Row).SpecialCells(xlCellTypeConstants).ClearContents
  Range("A4", Cells(derlig, Target.Column)).Sort Key1:=Range("B4"), Order1:=xlAscending, Key2:=Range( _
      "C4"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
      False, Orientation:=xlTopToBottom
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

[degap05]

Merci Skoobi, cela fonctionne parfaitement.
Accessoirement, j'ai un code qui colore ma ligne au fur et à mesure de l'avancement de la saisie des données. Ce qui est curieux, lorsque je renseigne la cellule cible en colonne Z, c'est qu'une ligne sans données se colore de la dernière couleur (48 = gris) à la fin des derniers enregistrements ?
Quelle en serait la cause ?

Merci.

End If
If Target.Column = 8 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 8)).Interior.ColorIndex = 43
Else
Range(Cells(Lig, 1), Cells(Lig, 8)).Interior.ColorIndex = xlNone
End If
End If
If Target.Column = 18 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 18)).Interior.ColorIndex = 44
Else
Range(Cells(Lig, 1), Cells(Lig, 18)).Interior.ColorIndex = xlNone
End If
End If
If Target.Column = 20 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 25)).Interior.ColorIndex = 48
Else
Range(Cells(Lig, 1), Cells(Lig, 25)).Interior.ColorIndex = xlNone
End If
End If

[skoobi]

A quoi correspond Lig? A la ligne de "Target"?
De plus la couleur grise est appliquée uniquement si "Target.Column = 20" non?
Pourrais-tu joindre tout le code?

[degap05]

Voila le code de mon fichier de travail, je suppose qu'il ne doit pas être trés "propre".
Oui la coloration en gris de toute la ligne se fait en colonne 20.


Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Lig, derlig, num1 As Integer, Couleur As Long
Lig = Target.Row
If Target.Count > 1 Then Exit Sub
'déprotège toute les feuilles
ActiveSheet.Unprotect
Sheets("Ordonnancier").Unprotect
Sheets("Patients").Unprotect
Sheets("Dotation").Unprotect
Sheets("Nominatif").Unprotect
If Target.Value = "" Then GoTo suite
If Target.Column = 26 Then
With Sheets("Ordonnancier")
.Visible = True
derlig = .Range("A65500").End(xlUp).Row + 1
.Cells(derlig, 2).Value = Cells(Lig, 2).Value
' tenir compte des 2 colonnes cachées
.Cells(derlig, 3).Value = Cells(Lig, 3).Value
.Cells(derlig, 4).Value = Cells(Lig, 10).Value
.Cells(derlig, 5).Value = Cells(Lig, 9).Value
.Cells(derlig, 6).Value = Cells(Lig, 12).Value
.Cells(derlig, 7).Value = Cells(Lig, 11).Value
.Cells(derlig, 8).Value = Cells(Lig, 20).Value
.Cells(derlig, 9).Value = Cells(Lig, 26).Value
.Cells(derlig, 10).Value = Cells(Lig, 8).Value
.Cells(derlig, 11).Value = Cells(Lig, 21).Value
.Cells(derlig, 12).Value = Cells(Lig, 22).Value
.Cells(derlig, 13).Value = Cells(Lig, 23).Value
.Cells(derlig, 14).Value = Cells(Lig, 24).Value
.Cells(derlig, 15).Value = Cells(Lig, 25).Value
.Cells(derlig, 1).Value = ActiveSheet.Name
num1 = .Cells(derlig - 1, 16).Value
.Cells(derlig, 16).Value = num1 + 1
End With
derlig = [A4].End(xlDown).Row
Range("A" & Target.Row & ":Z" & Target.Row).SpecialCells(xlCellTypeConstants).Clea rContents
Range("A4", Cells(derlig, Target.Column)).Sort Key1:=Range("B4"), Order1:=xlAscending, Key2:=Range( _
"C4"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
End If

' pour protéger la ligne qui vient d'être validée et enregistrée à l'ordonnancier
'Target.EntireRow.Select
'Selection.Locked = True
'Lig = Target.Row
'Cells(Lig + 0, 1).EntireRow.Select
'Selection.Locked = True
'pour remplir les données de l'imprimé Nominatif
'End If
If Target.Column = 18 Then
With Sheets("Nominatif")
derlig = .Range("A65500").End(xlUp).Row + 1
.Range("F11").Value = Cells(Lig, 9).Value
.Range("B9").Value = Range("H1").Value
.Range("D1").Value = Cells(Lig, 8).Value
.Range("B3").Value = Cells(Lig, 18).Value
.Range("B4").Value = Cells(Lig, 14).Value
.Range("B5").Value = Cells(Lig, 15).Value
.Range("B6").Value = Cells(Lig, 16).Value
.Range("B7").Value = Cells(Lig, 17).Value
.Range("B10").Value = Cells(Lig, 2).Value
.Range("B11").Value = Cells(Lig, 3).Value
.Range("F9").Value = Cells(Lig, 10).Value
.Range("E45").Value = Cells(Lig, 12).Value
.Range("E46").Value = Cells(Lig, 11).Value
num1 = .Range("F2").Value
.Range("F2") = num1 + 1
End With
'pour remplir les données de l'imprimé Dotation
End If
If Target.Column = 8 Then
With Sheets("Dotation")
derlig = .Range("A65500").End(xlUp).Row + 1
.Range("F11").Value = Cells(Lig, 6).Value
.Range("B9").Value = Range("H1").Value
.Range("D1").Value = Cells(Lig, 8).Value
.Range("B10").Value = Cells(Lig, 2).Value
.Range("B11").Value = Cells(Lig, 3).Value
.Range("F9").Value = Cells(Lig, 7).Value
num1 = .Range("F2").Value
.Range("F2") = num1 + 1
End With
'pour colorer les cellules à la dispensation
suite:
End If
If Target.Column = 8 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 8)).Interior.ColorIndex = 43
Else
Range(Cells(Lig, 1), Cells(Lig, 8)).Interior.ColorIndex = xlNone
End If
End If
If Target.Column = 18 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 18)).Interior.ColorIndex = 44
Else
Range(Cells(Lig, 1), Cells(Lig, 18)).Interior.ColorIndex = xlNone
End If
End If
If Target.Column = 20 Then
If Target.Value <> "" Then
Range(Cells(Lig, 1), Cells(Lig, 25)).Interior.ColorIndex = 48
Else
Range(Cells(Lig, 1), Cells(Lig, 25)).Interior.ColorIndex = xlNone
End If
End If
'protège toutes les feuilles
Application.EnableEvents = True
Application.ScreenUpdating = True
'Sheets("Ordonnancier").Protect
'Sheets("Patients").Protect
'Sheets("Dotation").Protect
'Sheets("Nominatif").Protect
'ActiveSheet.Protect
End Sub

[skoobi]

Re bonjour,

pour résoudre le problème exécute le code en "pas à pas" (F8).
Pour cela, ajoute un point d'arrêt au début du code (cliques dans la marge du code, un point rouge apparait et met en surbrillance la ligne).
Quand la macro démarre, continu là en pas à pas.
Ceci te permettra de comprendre se qui se passe (pas toujours ce que l'on souhaite...)
Voili voilou

[degap05]

Bonjour Skoobi, merci de tes directives. Je vais faire ce que tu préconises.

Bon dimanche.