copier une plage de cellule ensuite l'effacer

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 !!

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
 

Discussions similaires

Statistiques des forums

Discussions
312 221
Messages
2 086 382
Membres
103 199
dernier inscrit
ATS1