使用VBA将行从一个工作表复制到另一个工作表

Question

我有两张包含员工记录的表格。 Sheet1包含事件日期，CardNo，员工姓名，部门ID，员工编号，进入和退出时间，总工作时间，状态，ConcatinatedColumn和备注（通过表2中的vlookup复制）

Sheet2包含ConcatinatedColumn，Event Date，Employee No，Name，Remarks。

如果sheet2的备注栏中的数据是“Sick Off”，那么该行应该插入到sheet1而不会影响之前的记录。

我已经为它编写了代码，但它不起作用。

如果有人能帮助我，真的很感激！

感谢提前！

我的代码：

Sub SickOff()

Dim objWorksheet As Sheet2
Dim rngBurnDown As Range
Dim rngCell As Range
Dim strPasteToSheet As String

'Used for the new worksheet we are pasting into
Dim objNewSheet As Sheet1

Dim rngNextAvailbleRow As Range

'Define the worksheet with our data
Set objWorksheet = ThisWorkbook.Worksheets("Sheet2")


'Dynamically define the range to the last cell.
'This doesn't include and error handling e.g. null cells
'If we are not starting in A1, then change as appropriate
Set rngBurnDown = objWorksheet.Range("G2:G" & objWorksheet.Cells(Rows.Count,       "G").End(xlUp).Row)

'Now loop through all the cells in the range
For Each rngCell In rngBurnDown.Cells

objWorksheet.Select

If rngCell.Value = "Sick Off" Then
'select the entire row
rngCell.EntireRow.Select

'copy the selection
Selection.Copy

'Now identify and select the new sheet to paste into
Set objNewSheet = ThisWorkbook.Worksheets("Sheet1" & rngCell.Value)
objNewSheet.Select

'Looking at your initial question, I believe you are trying to find the next     available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)


Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If

Next rngCell

objWorksheet.Select
objWorksheet.Cells(1, 1).Select

'Can do some basic error handing here

'kill all objects
If IsObject(objWorksheet) Then Set objWorksheet = Nothing
If IsObject(rngBurnDown) Then Set rngBurnDown = Nothing
If IsObject(rngCell) Then Set rngCell = Nothing
If IsObject(objNewSheet) Then Set objNewSheet = Nothing
If IsObject(rngNextAvailbleRow) Then Set rngNextAvailbleRow = Nothing

End Sub

Answer 1

假设您有Sheet2中的数据，如下所示

假设Sheet1中的数据结尾看起来像这样

<强>逻辑：

我们正在使用自动过滤功能获取Sheet2中与Sick Off中的Col G匹配的相关范围。完成后，我们将数据复制到Sheet1中的最后一行。复制数据后，我们只需将数据混洗以匹配列标题。正如您所提到的那样，标题不会改变，因此我们可以自由地对列名进行硬编码以便对这些数据进行混洗。

<强>代码：

将此代码粘贴到模块中

Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim lRow As Long, wsOlRow As Long, OutputRow As Long
    Dim copyfrom As Range

    Set wsI = ThisWorkbook.Sheets("Sheet1")
    Set wsO = ThisWorkbook.Sheets("Sheet2")

    '~~> This is the row where the data will be written
    OutputRow = wsI.Range("A" & wsI.Rows.Count).End(xlUp).Row + 1

    With wsO
        wsOlRow = .Range("G" & .Rows.Count).End(xlUp).Row

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Filter G on "Sick Off"
        With .Range("G1:G" & wsOlRow)
            .AutoFilter Field:=1, Criteria1:="=Sick Off"
            Set copyfrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    If Not copyfrom Is Nothing Then
        copyfrom.Copy wsI.Rows(OutputRow)

        '~~> Shuffle data
        With wsI
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row

            .Range("A" & OutputRow & ":A" & lRow).Delete Shift:=xlToLeft
            .Range("F" & OutputRow & ":F" & lRow).Copy .Range("K" & OutputRow)
            .Range("F" & OutputRow & ":F" & lRow).ClearContents
            .Range("B" & OutputRow & ":B" & lRow).Copy .Range("E" & OutputRow)
            .Range("B" & OutputRow & ":B" & lRow).ClearContents
        End With
    End If
End Sub

<强>输出：