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

我有两张包含员工logging的表格。 Sheet1包含事件date，卡号，员工姓名，部门标识，员工编号，进入和退出时间，总工作时间，状态，ConcatinatedColumn和备注（通过从表单2查看）

Sheet2包含ConcatinatedColumn，事件date，员工编号，姓名，备注。

如果sheet2的备注栏中的数据是“Sick Off”，那么该行应插入Sheet1而不影响以前的logging。

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

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

提前致谢 ！

我的代码：

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 eg 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的数据结束如下所示

逻辑：

我们使用自动filter来获取与Col G中的Sick Off相匹配的Sheet2的相关范围。 一旦我们得到了，我们将数据复制到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 

输出：