Копировать данные строк из одного листа в другой при условии Да

Question

Я хочу скопировать данные с одного листа на другой лист при условии Да в столбце I.Я могу добавить данные в новый лист, но снова и снова копировать в одну и ту же строку.Я хочу, чтобы в 3-й строке было заполнение, затем они копируют данные на 5-ю, а не на 6-ю строки и т. Д. Этот код запускается только при выборе опции да из выпадающего списка.

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 только снова и снова дает мне 2-ю строку Sheet2 и перезаписывает данные новыми строками.

Answer 1

Простой способ копирования:

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

Answer 2

Это должно работать

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastRow As Long
    Dim WsSource As Worksheet, WsDest As Worksheet

    Set WsSource = ThisWorkbook.Sheets("Sheet1")
    Set WsDest = ThisWorkbook.Sheets("Sheet2")

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

    Application.EnableEvents = False
    On Error GoTo ErrHandler
    Debug.Print LastRow
    With WsDest
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        Debug.Print LastRow
        If UCase(Target.Text) = "YES" Then
            .Range("A" & LastRow).Resize(, 50).Value = _ 
                WsSource.Range("A" & Target.Row).Resize(, 50).Value
            Debug.Print "Record added"
        End If
    End With

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