Copy Partial Row Identified by ID

Question

I have two Excel sheets in a workbook that I am wanting to copy data between and I can't figure it out. I am trying to adapt the code from a prior answer here but I can't get it to function how I want.

In short the two sheets are "Active" and "Term" for if an employee is active with the company or not. I am trying to get a pop-up when I run the macro to request entry of the employee ID. Once entered I want to find that unique ID in column A and then select a portion of the cells (cells A to G) in that row (of the unique value) then cut and paste it in the next empty row in the "term" sheet. Once that is done I want to delete the entire row from the active sheet.

I've used the match function nested within an index function to reference the unique value and return data from the sheets and others but I can't figure out if those will somehow help and how to implement them. What I am asking may not be possible. I can record a macro but the values are static and would only work that one exact time. Thank you in advance.

Sub EmployeeTermination()
    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    Dim S As String
    Dim fVal As String
    Dim fRange As Range


    Set wssource = Worksheets("Active")
    Set wstarget = Worksheets("Term")

    iCol = 1
    MaxRowList = wssource.Cells(Rows.Count, iCol).End(xlUp).Row

    For x = MaxRowList To 1 Step -1
        S = wssource.Cells()
        If S = "Yes" Or S = "yes" Then

            fVal = InputBox(Enter employee ID:)

            Set fRange = wstarget.Columns("A:A").Find(What:=fVal, LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)

            If fRange Is Nothing Then

                AfterLastTarget = wstarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

                wssource.Rows(x).Copy
                wstarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If

        End If
    Next

   Application.ScreenUpdating = True

End Sub

Answer 1

I know this basically rewrote your code, but I added a few checks to ensure you want to delete your employee. I made the assumption that the employee's name is in column B, so if not you can change this line:

If MsgBox("Are you sure you want to terminate " & wsActive.Cells(rngEmployee.Row, _
                2) & "?", vbYesNo) Then

by replacing the 2 in the second row with whatever column number you would like. (or you can simply delete this check altogether).

I also added minimal error handling.

Option Explicit

Const Err_EmpNotFound = 1000

Public Function NextRow(ByVal ws As Worksheet, Optional ByVal col As Variant = 1) As Long
    With ws
        NextRow = .Cells(.Rows.Count, col).End(xlUp).Row + 1
    End With
End Function

Sub EmployeeTermination()
    'On Error GoTo ErrHandler

    Dim wsActive As Worksheet, wsTerm As Worksheet
    Set wsActive = ThisWorkbook.Worksheets("Active")
    Set wsTerm = ThisWorkbook.Worksheets("Term")

    'Locate the employee
    Dim rngEmployee As Range, sEmployeeID As String, empDataArr As Variant
    sEmployeeID = Application.InputBox("Enter Employee ID")
    Set rngEmployee = wsActive.Range("A:A").Find(sEmployeeID, Lookat:=xlWhole)
    If rngEmployee Is Nothing Then
        Err.Raise vbObjectError + Err_EmpNotFound, Description:="Employee Not Found"
    End If

    'Prompt before termination (assume's employee's name is column 2 (col B)
    If MsgBox("Are you sure you want to terminate " & wsActive.Cells(rngEmployee.Row, _
            2) & "?", vbYesNo) = vbNo Then
        Exit Sub
    End If
    empDataArr = rngEmployee.Columns("A:G").Value

    'Delete the data
    rngEmployee.EntireRow.Delete

    'Add employee to termination sheet (and date column "H")
    With wsTerm.Rows(NextRow(wsTerm))
        .Columns("A:G") = empDataArr
        .Columns("H") = Date
    End With

    'Notify user of completion
    MsgBox "Employee was successfully terminated!"
    Exit Sub

ErrHandler:
    Dim errBox As Long
    Select Case Err.Number - vbObjectError
        Case Err_EmpNotFound
            errBox = MsgBox(Err.Description, vbRetryCancel)
            If errBox = vbRetry Then
                Err.Clear
                EmployeeTermination
                End
            End If
        Case Else
            MsgBox Err.Description, Title:=Err.Number
    End Select
End Sub