Скопируйте строку excel в другой рабочий лист, когда выпадающее меню «Да», и когда «Нет» удаляет строку, если «Да» было выбрано ранее

Я пытаюсь скопировать строку excel на другой лист листа 2, когда выпадающее окно «Да» столбца F и когда «Нет» удаляет строку, если ранее было выбрано «Да». Я также хотел проверить, существует ли дубликат в листе 2, а затем запросить пользователя кнопкой «Да», «Нет». Если «Да» затем дублировать, если «Нет» ничего не делать.

ColA:Customer Name ColB:Customer Address ColC:Customer City ColD:Cust zip ColE:Tel ColF:Yes/No 

Я пробовал это.

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim lastrow As Long If UCase(Range("F" & ActiveCell.Row).Value) <> "YES" Then Exit Sub With ThisWorkbook.Worksheets("Sheet2") lastrow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row + 1) If WorksheetFunction.CountIf(.Range("A1:A" & lastrow), _ Range("A" & ActiveCell.Row).Value) > 0 Then Exit Sub Response = MsgBox("Record already exists, add again?", vbQuestion + vbYesNo + 256) If Response = vbNo Then Exit Sub .Range("A" & lastrow).Resize(, 5).Value = _ Range("A" & ActiveCell.Row).Resize(, 5).Value End With Response = MsgBox("Record added") End Sub 

Если я правильно вас понимаю, вам нужно что-то вроде этого (код запускается только в случае изменения значения в столбце F ):

 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("F:F")) Is Nothing Then Exit Sub Application.EnableEvents = False On Error GoTo ErrHandler With ThisWorkbook.Worksheets("Sheet2") lastrow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row + 1) If UCase(Target.Value) = "YES" Then Response = vbYes If WorksheetFunction.CountIf(.Range("A1:A" & lastrow), _ Range("A" & Target.Row).Value) > 0 Then Response = MsgBox("Record already exists, add again?", vbQuestion + vbYesNo + 256) End If If Response = vbYes Then .Range("A" & lastrow).Resize(, 5).Value = _ Range("A" & Target.Row).Resize(, 5).Value MsgBox "Record added" End If ElseIf UCase(Target.Value) = "NO" Then With .Range("A4:A" & lastrow) Set rng = .Find(What:=Range("A" & Target.Row), _ LookIn:=xlValues, _ lookAt:=xlWhole, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rngToDel Is Nothing Then Set rngToDel = rng.Resize(, 5) Else Set rngToDel = Union(rngToDel, rng.Resize(, 5)) End If Set rng = .FindNext(rng) If rng Is Nothing Then Exit Do Loop While fAddr <> rng.Address End If If Not rngToDel Is Nothing Then rngToDel.Delete Shift:=xlUp MsgBox "Records from sheet2 removed" End If End With End If End With ExitHere: Application.EnableEvents = True Exit Sub ErrHandler: Resume ExitHere End Sub 
Давайте будем гением компьютера.