Question

我想根据I列中的“是”条件将数据从一张纸复制到另一张纸。我可以在新工作表中添加数据，但是可以一次又一次地复制到同一行。我想要我的第三行是否已满，而不是它们复制5行而不是6行等数据。仅当我从下拉菜单中选择yes选项时，此代码才会运行。

MS Excel 2013

文件：https://www.dropbox.com/s/hfpjrmm1fgc6my3/EXCEL%20FORMULA.xlsm?dl=0

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastrow As Long
    Dim Response
    Dim rng As Range, rngToDel As Range
    Dim fAddr As String

    If Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub

    Application.EnableEvents = False
    On Error GoTo ErrHandler
    MsgBox (lastrow)
    With ThisWorkbook.Worksheets("Sheet2")
        Worksheets("Sheet2").Activate
        lastrow = ActiveSheet.Cells(.Rows.Count, "A").End(xlUp).Row + 1
        MsgBox (lastrow)
        If UCase(Target.Value) = "YES" Then
            Response = vbYes
            If Response = vbYes Then

                .Range("A" & lastrow).Resize(, 50).Value = _
                Range("A" & Target.Row).Resize(, 50).Value
                MsgBox "Record added"
            End If
        End If
    End With


ExitHere:
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    Resume ExitHere
End Sub

问题是我所面对的：lastrow仅一次又一次地给我Sheet2的第二行，并用新行覆盖数据。

Answer 1

这应该有效

Map

Answer 2

一种简单的复制方式：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim LastRow As Long

    If Not Intersect(Target, Range("I:I")) Is Nothing Then '<- If target change is in columnI

        LastRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 '<- Find last row of sheet 2 column A

        If UCase(Target.Value) = "YES" Then '<- If target value is "YES"

            Sheet1.Range("A" & Target.Row & ":O" & Target.Row).Copy Sheet2.Range("A" & LastRow) '<- Copy from sheet 1 range A:O target.row to sheet 2 last row

        End If

    End If

End Sub

根据是条件将行数据从一张复制到另一张

2 个答案: