Copy entire row from one workbook to another workbook if condition is met

Question

hoping someone is able to help me! I've been stuck for some time... Thanks in advance!

In Workbook 1, if column D (starting row 19 and higher) in Sheet1 is equal to "SOW", then copy entire row to first available row (after row 19) in Sheet1 Workbook 2. Once copied continue scanning through items in column D for more instances of "SOW".

Background - I am attempting to copy entire row as I have to copy the row from row A:NL - There are around 175 rows which it needs to go though

Below are two codes that I have tried to no avail. They essentially do nothing, there are no errors.

Sub TEST2()

Dim LastRow As Long, i As Long, erow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 4).Value = "SOW" Then
Range(Cells(i, 1), Cells(i, 400)).Select.Copy

Workbooks.Open Filename:="Y:\Station Operations\Station Ops Shared\WEST VACATION CALENDAR 2019.xlsm"
Worksheets("SOW_2019").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False

End If
Next i
End Sub

Sub TESTER()
Dim i As Long
Dim outRow As Long
Dim sourceWs As Worksheet, destWs As Worksheet

Set sourceWs = Workbooks("EAST VACATION CALENDAR 2019").Worksheets("SOE_2019")
Set destWs = Workbooks("WEST VACATION CALENDAR 2019").Worksheets("SOW_2019")

LastRow = ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Row

outRow = 1

    For i = 19 To LastRow

        If sourceWs.Cells(i, 4).Value = "SOW" Then

        sourceWs.Rows(i).EntireRow.Copy destWs.Rows(outRow)
        outRow = outRow + 1
        Application.CutCopyMode = False

        End If

    Next i
End Sub

Welcome to SO! The first code block repeatedly opens and closes a workbook for every line. That's going to slow you down. The second one copies but never pastes, doing nothing. We're going to need some more information to help you. Which workbook is this code running from? — HackSlash, May 13 '19 at 18:06
Thank you!! :) I'm just self learning VBA and Stackoverflow has so far been a life line!! I'm sure my codes are not very efficient! I have the code running out of Workbook 1. — SarahD17, May 13 '19 at 18:12
Read this: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?rq=1 — HackSlash, May 13 '19 at 18:17
Possible duplicate of [Copy Excel Row if Cell is equal to a value](https://stackoverflow.com/questions/19125372/copy-excel-row-if-cell-is-equal-to-a-value) — HackSlash, May 13 '19 at 19:21

HackSlash · Answer 1 · 2019-05-13T19:19:25.957

1

I'm going to assume we are running code in the East Calendar and outputting data to the West Calendar.

This allows me to explicitly name the workbooks and worksheets. Once I get a handle on my objects I can directly assign values to values without copy and paste. Destination = Source. I'm not sure if you wanted to start at row 19 or 2 so I chose 2 in order to look at more rows. Your two code examples are very different.

Sub TESTER()
    Dim sourceWs As Worksheet
    Set sourceWs = ThisWorkbook.Worksheets("SOE_2019")

    Dim westCalendar As Workbook
    Set westCalendar = Workbooks.Open(Filename:="Y:\Station Operations\Station Ops Shared\WEST VACATION CALENDAR 2019.xlsm")
    Dim destWs As Worksheet
    Set destWs = westCalendar.Worksheets("SOW_2019")

    Dim lastRow As Long
    lastRow = sourceWs.Range("A" & sourceWs.Rows.CountLarge).End(xlUp).Row

    Dim outRow As Long
    outRow = 1

    Dim i As Long
    For i = 2 To lastRow
        If sourceWs.Cells(i, 4) = "SOW" Then
            destWs.Rows(outRow).EntireRow.Value = sourceWs.Rows(i).EntireRow.Value
            outRow = outRow + 1
        End If
    Next i

    westCalendar.Close False
End Sub

edited May 13 '19 at 19:19

answered May 13 '19 at 18:16

HackSlash

4,944
2
18
44

I seem to be getting a Run-time error '1004' (Method 'Range' of object '_Worksheet' failed) on `lastRow = sourceWs.Range(“A” & sourceWs.Rows.CountLarge).End(xlUp).Row` – SarahD17 May 13 '19 at 18:54
Sounds like a problem with the declaration of the `sourceWs`. I can't see your workbook. Does that sheet exist? – HackSlash May 13 '19 at 19:20
yep, the sheet exists :s – SarahD17 May 13 '19 at 19:46
Might be those funky unicode quotes you had in the original. I replaced them with real quotes. Copy the code from my post again. It has changed. – HackSlash May 13 '19 at 19:47
that seems to have removed the error, it opens and closes the west calendar but does not paste in the copied line – SarahD17 May 13 '19 at 19:58
And you're using the new code that has `destWs.Rows(outRow).EntireRow.Value = sourceWs.Rows(i).EntireRow.Value` ? Because the way I originally wrote it wasn't doing anything. – HackSlash May 13 '19 at 20:00
unfortunately still not working. When I open up excel a security notice (Microsoft Office has identified a potential security concern... and I need to enable the macros), could this possibley explain why it isn't working? – SarahD17 May 13 '19 at 20:15
Yes. You need to allow macros to run or else they won't run. It's a security feature to keep you from running evil attack code from the internets. – HackSlash May 13 '19 at 20:19

Copy entire row from one workbook to another workbook if condition is met

1 Answers1