根据特定词语自动将单元格复制到另一个工作表

当单元格（H列）中出现单词“过期”时，我希望该行中的名称（在列A中）和date（在列F中）自动复制并粘贴到另一个工作表（名为HomePage）并显示列C12和E12。

我有下面的代码，但它正在剪切和粘贴整个行。 我只是想要一个名称和date的复制和粘贴到我的主页。

Private Sub Worksheet_Change (ByVal Target As Range) If Target.Column = 8 Then If Target.Value = "Overdue" Then R = Target.Row Rows(R).Cut Worksheets("HomePage").Select With ActiveSheet lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1 .Cells(lastrow, 1).Select .Paste End With End If End If End Sub 

Answer 1

既然你只需要两个单元格，为什么要复制和粘贴？ 只需直接赋值。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim R As Long If Target.Column = 8 Then If Target.Value = "Overdue" Then With Sheets("Homepage") R = .Cells(.Rows.Count, 3).End(xlUp).Row + 1 .Cells(R, 3) = Target.Offset(0, -7) ' Column C = Column A .Cells(R, 5) = Target.Offset(0, -2) ' Column E = Column F End With End If End If End Sub 

Answer 2

根据你的叙述

我希望该行中的名称（在列A中）和date（在列F中）自动复制并粘贴到另一个工作表（名为HomePage），并出现在列C12和E12中。

将下面的代码放在工作表代码窗格中

 Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Column = 8 And .Value = "Overdue" Then Sheets("Homepage").Range("C12").Value = Range(.row, "A") Sheets("Homepage").Range("E12").Value = Range(.row, "F") End If End With End Sub