Suppression ligne après couper/coller

rainbow69006

XLDnaute Occasionnel
Bonjour à tous,

Je viens d'utiliser une partie d'un code trouver sur le forum qui marche parfaitement!!
Dans ma feuille "données": Celui ci coupe la ligne si la cellule correspondante en AZ est modifié et la colle dans une feuille "classer".
Cela marche parfaitement.

Par contre seul problème dans ma feuille donnée il me garde la ligne (qui devient vide) n'est il pas possible de supprimer la ligne?

merci d'avance


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Plage As Range
Set Plage = Intersect(Target, Range([AG2], Cells(Rows.Count, "AZ").End(xlUp)))
If Plage Is Nothing Then Exit Sub
For Each Cel In Plage
    If IsDate(Cel) Then
        With Sheets("classer")
            Rows(Cel.Row).Cut .Cells(Rows.Count, "A").End(xlUp)(2)
        End With
    End If
Next Cel
Application.CutCopyMode = False
End Sub
 

Boubix

XLDnaute Nouveau
Re : Suppression ligne après couper/coller

Bonjour Rainbow,

je ne suis pas un expert mais peut être que cela peut marcher avec une fonction du type:

Cells(Rows.Count, 2).EntireRow.Select
Selection.Delete

Juste une idée :p

Désolé de pas pouvoir en faire plus.
 

rainbow69006

XLDnaute Occasionnel
Re : Suppression ligne après couper/coller

Bonjour,

Il y a peut être plus simple, mais j'ai finalement utilisé ce code qui marche (mais qui prend un peu de temps...)

Code:
 Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Plage As Range
Set Plage = Intersect(Target, Range([AG2], Cells(Rows.Count, "AZ").End(xlUp)))
If Plage Is Nothing Then Exit Sub
For Each Cel In Plage
    If IsDate(Cel) Then
        With Sheets("classer")
            Rows(Cel.Row).Cut .Cells(Rows.Count, "A").End(xlUp)(2)
        End With
    End If
Next Cel
Application.CutCopyMode = False


dernLigne = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Count - 1

Application.ScreenUpdating = False

For i = dernLigne To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete Shift:=xlUp
End If
Next i

End Sub
 

Discussions similaires

Réponses
2
Affichages
475

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou