首页 > 解决方案 > 获取 excel 将整行粘贴到新工作表上的下一个可用位置,而不是覆盖已经存在的数据

问题描述

如果列包含关键字,我将使用此代码复制/粘贴整行。我将宏分配给一个按钮。它可以工作,但如果我得到一个标记为完成的新项目并再次按下按钮,它会删除“完成”工作表上的所有内容并粘贴新信息。我希望它粘贴在最后一行下面。

    Dim i As long
    Dim p As long
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("In Progress")
    Set Target = ActiveWorkbook.Worksheets("Complete")

    p = 3     ' Start copying to row 3 in target sheet
    Dim lastrow As Integer: lastrow = Source.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

    For i = lastrow To 3 Step -1
        If Source.Range("B" & i).Value = "Complete" Then
        Source.Rows(i).Copy Target.Rows(p)
        Source.Rows(i).EntireRow.Delete
        p = p + 1
    End If
Next
End Sub

谷歌搜索后,看来我需要类似的东西

lastrow = Sheet2.Range("A99999").End(xlUp).Row + 1.

我是否有点接近我需要解决的问题?谢谢您的帮助。

标签: excelvba

解决方案


工作版本:

Sub TransferComplete()
    Dim i As long
    Dim p As long
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("In Progress")
    Set Target = ActiveWorkbook.Worksheets("Complete")

    p = Target.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1    ' Start copying to last row in target sheet
    Dim lastrow As long: lastrow = Source.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

    For i = lastrow To 3 Step -1
        If Source.Range("B" & i).Value = "Complete" Then
        Source.Rows(i).Copy Target.Rows(p)
        Source.Rows(i).EntireRow.Delete
        p = p + 1
    End If
Next
End Sub

我删除p = 3并替换为p = Target.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1


推荐阅读