Excel VBA, Copy and paste data from one worksheet to another then delete copy data source

Question

I am having difficulty creating a macro that will copy a row of data from one worksheet to another, then instantly delete the copied data source and move up the rows underneath to clear the leftover blank/empty row. The context of this workbook is a request tracker, once a request has a completion date, after a certain period of time (30 days), the request will be copied over to a "historical requests" sheet. Then immediately after, the originally copied data on the active page will be deleted and everything else "moved up" to clear out the gap left behind. Here is what I have already developed, with some help of course... If someone could help, it would be greatly appreciated.

Public Sub DataBackup()
Dim RowDate
Dim CurrentDate
Dim Interval
Dim CurrentAddress
Dim ValueCellRange As Range
Dim ValueCell As Range
Dim ws As Worksheet

'Interval set to an appropriate number of days
Interval = 30
CurrentDate = Now()

For Each ws In Worksheets
    Set ValueCellRange = ws.Range("U3:U130")
    For Each ValueCell In ValueCellRange
        If ValueCell.Value <> "" Then
            If CurrentDate - ValueCell.Value >= Interval Then

                Rows(ActiveCell.Row).Select

                Sheets("Historical Requests").Select
                ActiveSheet.Paste

                ValueCell.EntireRow.ClearContents
            End If
        End If
    Next ValueCell
Next ws

'Clear variable value for next initialization
Set ValueCell = Nothing



End Sub

Is this all of the code, or are you stuck on how to do a part of it? Also, I highly suggest looking in to [how to avoid using `.Select/`.Activate`](https://stackoverflow.com/questions/10714251/) as it will help cut down on the code and be more direct in working with the data. Also, you should put the worksheet before `Rows(...).Select` otherwise it's just going to select/use the row on the activesheet. — BruceWayne, May 11 '17 at 19:03

score 0 · Answer 1 · answered May 11 '17 at 20:27

You did put the work into it. As BruceWayne suggested your code is not bad but could use less selecting and less activating. You don't need to select or activate a worksheet or range to work with it. Here is code that is a little more efficient, and I think many others could make it even more efficient.

BTW, when deleting rows try to always work from the bottom-up. And make sure that column "H" is formatted as dates, or this my not work.

Sub copyCut()
Dim ws_DATA As Worksheet, ws_HISTORY As Worksheet
Dim lastRowHISTORY As Long

Set ws_DATA = Sheet3'   Change this sheet to match your correct one
Set ws_HISTORY = Worksheets(4)' Change this sheet to match your correct one


For i = 130 To 3 Step -1
    On Error Resume Next
    lastRowHISTORY = ws_HISTORY.Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row + 1
    If Err.Number = 91 Then lastRowHISTORY = 1
    On Error GoTo 0

    If Now - DateValue(ws_DATA.Range("U" & i).Value) > 29 Then
        ws_DATA.Range("U" & i).EntireRow.Copy Destination:=ws_HISTORY.Range("A" & lastRowHISTORY)
        ws_DATA.Range("U" & i).EntireRow.Delete
    End If
Next i
Set ws_DATA = Nothing
Set ws_HISTORY = Nothing

End Sub

Hello John, Thank you for this. However, I feel I have been rather shy with the details. There are four primary worksheets in my workbook that have the data or "Requests". Then their data is to be copied to the "Historical Requests" once the completion date of a request ages 30 days.For example, let's say I have a request from one region to another on one of my primary worksheets. It aged 30 days. Now I need to copy and paste it into the "Historical Requests" worksheet. After the data has been transferred, its original source must be deleted off of the primary sheet it originated from. — Scope1414, May 15 '17 at 18:54
Immediately after this takes place, that empty space left over must be filled by the other entries below it to avoid the appearance of blank entries. I don't even know where to start with this code... — Scope1414, May 15 '17 at 18:58

John Muggins · Answer 2 · 2017-05-15T20:20:57.650

To loop through all four sheets just put a "for 1 = n to 4" loop in the script. The only problem I can foresee is if all four pages have different row counts. Easy fix if they are not all 130. Just let me know. It only takes code to find the last used row on each sheet.

    Sub copyCut()
    Dim ws_DATA As Worksheet, ws_HISTORY As Worksheet
    Dim lastRowHISTORY As Long

    Set ws_DATA = Sheet3'   Change this sheet to match your correct one
    Set ws_HISTORY = Worksheets(4)' Change this sheet to match your correct one

    For n = 1 to 4

    Select Case n
         Case 1
             Set ws_DATA = Worksheets("Sheet1")' change these to your sheet names
         Case 2 
             Set ws_DATA = Worksheets("Sheet2")
         Case 3 
             Set ws_DATA = Worksheets("Sheet3")
         Case 4 
             Set ws_DATA = Worksheets("Sheet4")

    End Select 

    For i = 130 To 3 Step -1
        On Error Resume Next
        lastRowHISTORY = ws_HISTORY.Cells.Find(What:="*", _
                        After:=Range("A1"), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row + 1
        If Err.Number = 91 Then lastRowHISTORY = 1
        On Error GoTo 0

        If Now - DateValue(ws_DATA.Range("U" & i).Value) > 29 Then
            ws_DATA.Range("U" & i).EntireRow.Copy Destination:=ws_HISTORY.Range("A" & lastRowHISTORY)
            ws_DATA.Range("U" & i).EntireRow.Delete
        End If
    Next i


Next n

Set ws_DATA = Nothing
Set ws_HISTORY = Nothing

End Sub

The line of code 'If Now - DateValue(ws_DATA.Range("U" & i).Value) > 29 Then' is returning a mismatch error. "Run-time error 13". Will this part of the code look through each row in Column "U" and check the date against the interval 29? There may also be blank vales in some of these rows because certain requests may not be completed. — Scope1414, May 30 '17 at 14:48

Excel VBA, Copy and paste data from one worksheet to another then delete copy data source

2 Answers2