在上一个问题here中,我从“活动”电子表格中复制一行并将其放在“术语”电子表格中,但是我们更改了“活动”工作表上的列的方式。
以前,我会在活动工作表上复制列“ A:G”,然后在“条款”上粘贴“ A:G”。
现在“ A:G”是“ A:D”,然后是“ G:I”,所以我试图根据列号找出如何复制行的每一节。
完整的现有代码在这里:
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 TEST_COPY()
On Error GoTo ErrHandler
Dim wsActive As Worksheet, wsTerm As Worksheet
Dim wbCOPYMaster As Workbook
Set wbCOPYMaster = Workbooks("COPY.xlsx")
Set wsActive = wbCOPYMaster.Worksheets("Active Employees")
Set wsTerm = wbCOPYMaster.Worksheets("Terminations")
wsActive.Activate
'Locate the employee
Dim rngEmployee As Range, sEmployeeID As String
Dim empDataArr As Variant, empDataArr2 As Variant
sEmployeeID = Application.InputBox("Enter Employee ID")
Set rngEmployee = wsActive.Range("B:B").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 6 (col F)
If MsgBox("Are you sure you want to terminate " & wsActive.Cells(rngEmployee.Row, _
6) & "?", vbYesNo) = vbNo Then
Exit Sub
End If
empDataArr = wsActive.Range("A" & rngEmployee.Row & ":BH" & rngEmployee.Row)
empDataArr2 = wsActive.Range("CY" & rngEmployee.Row & ":DN" & rngEmployee.Row)
'Add employee to termination sheet
With wsTerm.Rows(NextRow(wsTerm))
.Columns("A:BH") = empDataArr
.Columns("BI:BX") = empDataArr2
.Columns("BY") = Date
End With
'Delete the data
rngEmployee.EntireRow.Delete
'Notify user of completion
MsgBox "Employee was successfully terminated!"
Exit Sub
ErrHandler:
Dim errBox As Long
Select Case Err.Number
Case Err_EmpNotFound + vbObjectError
errBox = MsgBox(Err.Description, vbRetryCancel)
If errBox = vbRetry Then
Err.Clear
TEST_COPY
End
End If
Case Else
MsgBox Err.Description, Title:=Err.Number
End Select
End Sub