Question

希望有人能够帮助我！我已经被卡住了一段时间了……预先感谢！

在工作簿1中，如果Sheet1中的D列（从第19行开始及以后的行）等于“ SOW”，则将整个行复制到Sheet1 Workbook 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

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

这使我可以明确命名工作簿和工作表。一旦获得对象的手柄，就可以直接将值分配给值，而无需复制和粘贴。 Destination = 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

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

1 个答案: