使用 VBA 将一行从一张纸复制到另一张纸

Copy a row from one sheet to another using VBA

提问by Faaria Mariam

I have two sheets containing the employee records. Sheet1 contains the Event Date, CardNo, Employee Name, Dept Id, Employee No, Entry and Exit Time, Total Working Hours, Status, ConcatinatedColumn and Remarks (copied through vlookup from sheet2)

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

Sheet2 contains ConcatinatedColumn, Event Date, Employee No, Name, Remarks.

Sheet2 包含 ConcatinatedColumn、事件日期、员工编号、姓名、备注。

If the data in the remarks column of sheet2 is "Sick Off" then that row should be inserted to sheet1 without effecting the previous records.

如果 sheet2 备注栏中的数据为“Sick Off”，则应将该行插入到 sheet1 中，而不影响以前的记录。

I've already written the code for it but it does not work.

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

Would be really grateful if anyone can help me out !

如果有人可以帮助我，将不胜感激！

THANKS IN ADVANCE !

提前致谢 ！

MY CODE :

我的代码：

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

回答by Siddharth Rout

Let's say you have data in Sheet2as shown below

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

Let's say the end of data in Sheet1looks like this

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

Logic:

逻辑：

We are using autofilter to get the relevant range in Sheet2which match Sick Offin Col G. Once we get that, we copy the data to the last row in Sheet1. After the data is copied, we simply shuffle data across to match the column headers. As you mentioned that the headers won't change so we can take the liberty of hardcoding the column names for shuffling this data.

我们正在使用自动筛选来获得在相关范围内Sheet2，其匹配Sick Off的Col G。一旦我们得到它，我们将数据复制到Sheet1. 复制数据后，我们只需将数据混洗以匹配列标题。正如您提到的，标题不会改变，因此我们可以自由地硬编码列名称以重新排列这些数据。

Code:

代码：

Paste this code in a module

将此代码粘贴到模块中

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

Output:

输出：