Excel VBA copy pasting error

Question

I wanted to create a VBA macro that will copy the entire row and paste it in another worksheet in Excel.

My worksheet goes from column A to D, and has about 700 rows. Column D is some random date.

Problem: I have to determine expired date (and expired date is always 'today') and copy to a new sheet named 'Expired'. What I do is find the date, highlight, copy, paste, then clear highlight, but I am having trouble pasting the cells in the worksheet named 'Expired' (only the 1st row is pasted with values)

Sub ExtractExpired()

    Application.ScreenUpdating = False

    Sheets("Sheet1").Select

    Range("d1").Select

    Selection.Offset(1, 0).Select


    x = Date
    Z = vbBlue

    Do Until Selection.Offset(0, -2).Value = ""


        If Selection.Offset(0, 0).Value < x Then 'And Selection.Offset(0, 0).Value <= x Then
            Range(Selection.Offset(0, -3), Selection.Offset(0, 0)).Interior.Color = Z 'And Range(Selection.Offset(0, -3), Selection.Offset(0, 0)).Font.Color = vbBlue

        'If Selection.Offset(0, 0).Interior.Color = Z Then


            'r = Range("a1").End(xlDown).Row
                'countexpired = 2

            'For q = r To 2 Step -1

                'Range(Cells(q, "a"), Cells(q, "d")).Copy


                    'If Selection.Offset(0, 0).Interior.Color = Z Then
                        'Sheets("Expired").Select
                        'Cells(countexpired, "A").Select
                        'ActiveSheet.Paste

                        'countexpired = countexpired + 1
                        'Sheets("Sheet1").Select
                    'End If

            'Next

            'Call sortItem
            'Range(Selection.Offset(0, -3), Selection.Offset(0, 0)).Copy (Worksheets("Expired").Range("d1"))
            'ActiveCell.EntireRow.Copy (Worksheets("Expired").Range("d1"))

        'End If
        End If
        Selection.Offset(1, 0).Select


    Loop



    Application.ScreenUpdating = True


End Sub

Welcome to SO! Exactly what error are you getting, and where? Also, all that commented-out code makes it hard to understand. Is it the problem code that's commented out? Please read [mcve] and [ask]. — Mathieu Guindon, Jun 30 '17 at 15:15
Also: [how to avoid using Select and Activate in Excel VBA macros](https://stackoverflow.com/q/10714251/1188513) — Mathieu Guindon, Jun 30 '17 at 15:17

score 1 · Answer 1 · answered Jun 30 '17 at 15:20

As I understand you are trying to copy the first four columns of an row to another sheet in case your date criteria is matched. The code below should do the trick, however it does not highlight the cell, as you delete the highlights afterwards anyway. If you want to run this code every day you will need to adjust the c value everyday, to latest row used.

Sub CopyPaste()
Dim ws1 as worksheet, ws2 as worksheet
Dim i as integer, j as integer
Dim x as Date
x = Date
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Expired")
i = 2 ' First row used in Sheet 1
c = 2 ' First row used in Expired Sheet

Do until IsEmpty(ws1.Cells(i,4))
   if ws1.Cells(i,4) = x Then
       ws1.Range(ws1.Cells(i,1),ws1.Cells(i,4)).copy Destination:=ws2.Range(w2.Cells(c,1),w2.Cells(c,4))
       c = c +1 ' move to next row in expired sheet when value has been copied
   end if
   i = i +1 ' move to next row in Sheet1 regardless if value has been copied or not
Loop
End Sub

Upvoted, but updating a macro daily just to change a constant's value is outright nuts. See [how to find the last row with data](https://stackoverflow.com/a/11169920/1188513). Also, you should always declare your variables. `c` is an implicit `Variant` assigned to an `Integer`, which means incrementing it to >32,767 will overflow. `Dim c As Long` and avoid problems. — Mathieu Guindon, Jun 30 '17 at 15:24

Excel VBA copy pasting error

1 Answers1