如果满足条件，则将整行从一个工作簿复制到另一个工作簿

Question

希望有人能帮我！我已经被困了一段时间了...提前谢谢！

在工作簿1中，如果Sheet1中的D列（起始行19及更高）等于“SOW”，则将整行复制到Sheet1工作簿2中的第一个可用行（第19行之后）。复制后，继续扫描D列中的项目以获取更多“SOW”实例。

背景-我正在尝试复制整行，因为我必须从A行复制该行：NL-大约有175行需要通过

下面是我尝试过的两个代码，但都没有用。他们基本上什么都不做，没有错误。

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

Answer 1

我假设我们正在运行东日历中的代码，并将数据输出到西日历。

这允许我显式命名工作簿和工作表。一旦我获得了对象的句柄，我就可以直接将值分配给值，而无需复制和粘贴。Destation=Source。我不确定您是想从第19行还是第2行开始，所以我选择了2以便查看更多行。您的两个代码示例非常不同。

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