sylvestre09
XLDnaute Nouveau
bonjour le forum, voilà j'ai un code qui me permet de supprimer une plage de cellules lorsque la date est anterieur ou egale à la date d'aujourd'hui mais je veux que pour les dates d'aujourd'hui, copier la plage de celulles avant de la supprimer et ceci seulement pour la page "Rec"
Le code pour copier ne marche pas du tout je veux copier dans la colonne 20 (T) la premiere cellule vide à partir de la ligne 4
quelqu'un pourrai m'aider ??
Merci d'avance !!
Le code pour copier ne marche pas du tout je veux copier dans la colonne 20 (T) la premiere cellule vide à partir de la ligne 4
quelqu'un pourrai m'aider ??
Merci d'avance !!
Code:
Dim Sh As Worksheet
Dim i As Long, derling As Long, T As Long
For Each Sh In Worksheets
If Sh.Name <> "Feuil1" Then
With Sh
If Sh.Name = "Rec" Then
For i = .Range("E65536").End(xlUp).Row To 4 Step -1
If CDate(.Cells(i, 5)) = Date Then .Range(Cells(i, "C"), .Cells(i, "M")).Copy Destination:=(.Cells(65535, 20).End(xlUp).Row + 1) ' ICI COPIER ENSUITE SUPPRIMER If CDate(.Cells(i, 5)) < Date Then .Range(Cells(i, "C"), .Cells(i, "M")).Delete (xlUp)
Next
Else:
For i = .Range("E65536").End(xlUp).Row To 4 Step -1
If CDate(.Cells(i, 5)) <= Date Then T = T + 1
Next
If MsgBox("Il y a " & T & " ligne(s) à supprimer" & vbCrLf & "Confirmer la suppresion ?", vbYesNo, "Suppression des lignes") = vbYes Then
Application.ScreenUpdating = False
For i = .Range("E65536").End(xlUp).Row To 4 Step -1
If CDate(.Cells(i, 5)) <= Date Then .Range(.Cells(i, "A"), .Cells(i, "Q")).Delete (xlUp)
Next
Application.ScreenUpdating = True
End If
End If
End With
End If
Next Sh
End Sub