Trier et déplacer des lignes barrées

[Rouli]

Bonjour,

pour gérer une facturation semestrielle, j'ai créer ce fichier avec des mises en forme conditionnelles.

Je cherche maintenant à déplacer les cellules barrées de la feuille 'en cours' dans une autre feuille 'terminé'. J'ai trouvé sur internet une fonction pour cacher les cellules si la police est barrée (qui ne fonctionne pas dans mon classeur d'ailleurs?).

Seriez-vous comment faire pour déplacer les cellules qui seraient barrées dans la feuille 'en cours' dans la feuille 'terminé'?

D'avance merci

 

[david84]

Bonjour,
pour masquer les lignes :

Sub Masqueligne2()
Dim I As Long, Pl As Range
Application.ScreenUpdating = False
Set Pl = [A1].CurrentRegion
For I = Pl.Rows.Count To 2 Step -1
  If Pl(I, 5).Value = "x" Then Pl.Rows(I).Hidden = True
Next I
Application.ScreenUpdating = True
End Sub

A+

 

[Rouli]

Bonjour,
pour masquer les lignes :

Sub Masqueligne2()
Dim I As Long, Pl As Range
Application.ScreenUpdating = False
Set Pl = [A1].CurrentRegion
For I = Pl.Rows.Count To 2 Step -1
  If Pl(I, 5).Value = "x" Then Pl.Rows(I).Hidden = True
Next I
Application.ScreenUpdating = True
End Sub

A+

Merci,
ça cache bien les lignes.
En revanche cela cache toutes les lignes ou il y a une police barrée. Ce que je souhaiterai c'est qu'il cache la ligne seulement si la police de la colonne A est barrée.

Sinon, plus que les cacher, si tu sais comment les copier dans le deuxieme onglet je suis preneur.

Encore merci!

 

[david84]

Il te suffit de modifier la condition :

If Pl(I, Pl.Columns.Count).Value = "x" Then Pl.Rows(I).Hidden = True

Pour le reste je n'ai pas le temps actuellement.
A+

 

[Rouli]

Il te suffit de modifier la condition :

If Pl(I, Pl.Columns.Count).Value = "x" Then Pl.Rows(I).Hidden = True

Pour le reste je n'ai pas le temps actuellement.
A+

Merci beaucoup.
Si quelqu'un d'autre a une idée...
A+

 

[chris]

Bonjour à tous

Sub Masqueligne()
Dim I As Long, Pl As Range, DestLig As Long
Application.ScreenUpdating = False
With Worksheets("En cours")
    Set Pl = .[A1].CurrentRegion
    DestLig = Worksheets("Terminé").Cells(1, 1).CurrentRegion.Rows.Count + 1
    For I = Pl.Rows.Count To 2 Step -1
      If Pl(I, 1).DisplayFormat.Font.Strikethrough = True Then
        Pl.Rows(I).Cut (Worksheets("Terminé").Cells(DestLig, 1))
        Pl.Rows(I).Delete Shift:=xlUp
        DestLig = DestLig + 1
    End If
    Next I
End With
Application.ScreenUpdating = True
End Sub

Si la copie ne doit pas avoir la MFC il faudra ajouter une ligne pour la supprimer...

 

[Rouli]

Bonjour à tous

Sub Masqueligne()
Dim I As Long, Pl As Range, DestLig As Long
Application.ScreenUpdating = False
With Worksheets("En cours")
    Set Pl = .[A1].CurrentRegion
    DestLig = Worksheets("Terminé").Cells(1, 1).CurrentRegion.Rows.Count + 1
    For I = Pl.Rows.Count To 2 Step -1
      If Pl(I, 1).DisplayFormat.Font.Strikethrough = True Then
        Pl.Rows(I).Cut (Worksheets("Terminé").Cells(DestLig, 1))
        Pl.Rows(I).Delete Shift:=xlUp
        DestLig = DestLig + 1
    End If
    Next I
End With
Application.ScreenUpdating = True
End Sub

Si la copie ne doit pas avoir la MFC il faudra ajouter une ligne pour la supprimer...

Super merci !

A partir de cela, j'ai essayé de faire une fonction "retour" au cas où :

Sub Ligne_reprise()
Dim I As Long, Pl As Range, DestLig As Long
Application.ScreenUpdating = False
With Worksheets("Terminé")
Set Pl = .[A2].CurrentRegion
DestLig = Worksheets("En cours").Cells(1, 1).CurrentRegion.Rows.Count + 1
For I = Pl.Rows.Count To 2 Step -1
If Pl(I, 1).DisplayFormat.Font.Strikethrough = False Then
Pl.Rows(I).Cut (Worksheets("Terminé").Cells(DestLig, 1))
Pl.Rows(I).Delete Shift:=xlUp
DestLig = DestLig + 1
End If
Next I
End With
Application.ScreenUpdating = True
End Sub

Elle enlève bien la ligne, seulement elle ne la colle pas dans la feuille 'En cours'. Vois tu ou je me trompe?

 

[chris]

RE

Pl.Rows(I).Cut (Worksheets("Terminé").Cells(DestLig, 1)) : la destination doit être En cours et non Terminé

Ton code doit avoir copié plus bas dans Terminé...

 

[Rouli]

RE

Pl.Rows(I).Cut (Worksheets("Terminé").Cells(DestLig, 1)) : la destination doit être En cours et non Terminé

Ton code doit avoir copié plus bas dans Terminé...

Merci beaucoup!
Sais tu comment ensuite les classer du plus ancien au plus récent une fois copié, pour qu'il s'insère à la bonne place et pas forcément en bas ?

 

[chris]

Re

Plus simple de lancer un tri en fin de traitement sinon tu pars sur une usine à gaz...

 

[Rouli]

Ok merci