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
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas