在Excel中复制部分数组并转置

时间:2018-06-19 12:59:20

标签: vba excel-vba excel-formula copy excel-2010

在上一个问题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

0 个答案:

没有答案