Copy excel row in different worksheet when cell dr

2019-08-03 23:08发布

I am trying to copy excel row in different worksheet sheet 2 when cell dropdown "Yes" of Column F and when "No" removes the row if "Yes" was selected previously. I also wanted to check if duplicate exists in worksheet 2, then prompt user with "Yes", "No" button. If "Yes" then duplicate if "No" do nothing.

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

I have tried this.

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

1条回答
甜甜的少女心
2楼-- · 2019-08-03 23:51

If I understand you correctly, you need something like this (code runs only if changed value in column 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
查看更多
登录 后发表回答