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

D

degap05

XLDnaute Impliqué
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
 
Dernière édition:
Trier par date Trier par votes
skoobi

skoobi

XLDnaute Barbatruc
Re : Effacer les données d'une ligne et retrier les données de la feuille

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.
 
Vote positif 0 Vote négatif
D

degap05

XLDnaute Impliqué
Re : Effacer les données d'une ligne et retrier les données de la feuille

skoobi à dit:
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.
Cliquez pour agrandir...


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.
 
Dernière édition:
Vote positif 0 Vote négatif
D

degap05

XLDnaute Impliqué
Re : Effacer les données d'une ligne et retrier les données de la feuille

degap05 à dit:
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.
Cliquez pour agrandir...

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

Pièces jointes

  • Copie-Vide-Trie.zip
    3.1 KB · Affichages: 22
  • Copie-Vide-Trie.zip
    3.1 KB · Affichages: 22
  • Copie-Vide-Trie.zip
    3.1 KB · Affichages: 22
Vote positif 0 Vote négatif
D

degap05

XLDnaute Impliqué
Re : Effacer les données d'une ligne et retrier les données de la feuille

skoobi à dit:
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?
Cliquez pour agrandir...

Bonjour, j'ai pensé que ce code ne servirait pas forcément et qu'il était encombrant:eek:, 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
 
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Effacer les données d'une ligne et retrier les données de la feuille

Bonjour,

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

Code: 
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
 
Vote positif 0 Vote négatif
D

degap05

XLDnaute Impliqué
Re : Effacer les données d'une ligne et retrier les données de la feuille

Bonjour, Skoobi,

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

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.
 

Pièces jointes

  • Copie-Vide-Trie.zip
    15.1 KB · Affichages: 28
  • Copie-Vide-Trie.zip
    15.1 KB · Affichages: 29
  • Copie-Vide-Trie.zip
    15.1 KB · Affichages: 31
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Effacer les données d'une ligne et retrier les données de la feuille

Re,

ça devrait aller mieux comme ça:

Code: 
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
 
Vote positif 0 Vote négatif
D

degap05

XLDnaute Impliqué
Re : Effacer les données d'une ligne et retrier les données de la feuille

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
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Effacer les données d'une ligne et retrier les données de la feuille

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?
 
Vote positif 0 Vote négatif
D

degap05

XLDnaute Impliqué
Re : Effacer les données d'une ligne et retrier les données de la feuille

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).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

' 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
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Effacer les données d'une ligne et retrier les données de la feuille

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
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
XL pour MAC trier des données tableau excel selon ordre donné
2
Réponses
16
Affichages
774
clineM
C
B
  • Question
XL 2021 Trier sous excel
Réponses
3
Affichages
160
bourcier1952
B
_l_ours
  • Résolu(e)
XL 2016 Créer une feuille si elle n'existe pas + Copier une plage de cellule d'une feuille à l'autre
Réponses
9
Affichages
218
_l_ours
_l_ours
P
  • Question
XL 2010 Récupérer les infos d'une ligne sélectionnée
Réponses
2
Affichages
172
Perceval64
P
C
  • Question
XL 2016 EXCEL - Recopier une ligne en insérant des cellules entre les valeurs
Réponses
2
Affichages
266
CorineL
C
G
  • Résolu(e)
Microsoft 365 Copie d'une ligne vers une autre feuille VBA
Réponses
4
Affichages
476
Dranreb
Dranreb
D
  • Question
XL 2016 macro pour copier coller des cellules d'une feuille dans une autre feuille avec condition
Réponses
2
Affichages
248
Phil69970
Phil69970
P
  • Résolu(e)
Autres Effacer données de certaines cellules si la feuille passe de visible à masquée
Réponses
6
Affichages
382
Panda79360
P
J
  • Résolu(e)
XL 2016 Validation d'une ligne et transfert de la ligne vers un autre classeur
Réponses
8
Affichages
211
job75
job75
P
  • Question
XL 2016 Validation de données
Réponses
1
Affichages
354
fanch55
fanch55

Membres actuellement en ligne

11 membres et 128 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 176
Messages
2 085 965
Membres
103 069
dernier inscrit
jujulop