最干净的解决方案是这样的：
在工作簿级别添加事件处理程序以捕获正在更改的单元格；在处理程序中，执行以下操作：
- 关闭事件处理（您将要更改工作表并且不想进入无限循环）！
- 关闭屏幕更新
- 在前页的第 1 行中插入一行
- 在此处输入已更改行的副本
- 在附加列中添加更改用户以及日期/时间（如果您愿意）
- 返回原来的选择
- 开启屏幕更新
- 开启事件处理
这里是分步说明（示例文件可以从http://www.floris.us/SO/download/XLexample.xlsm 下载） - 假设 PC 上使用 Excel 2010。其他版本大多会有细微差别...
- 确保您的文件保存为
.xlsm 格式 - 这告诉 Excel 有宏
- 在添加所有这些内容之前创建文件的备份 - 以防您搞砸了！
- 关闭所有其他文件（暂时） - 查看之前的评论
- 确保您的文件有四个工作表：“summary”、“widgets”、“things”和“stuff”（或任何您认为有帮助的名称 - 我将使用这些名称而不是“Sheet1”等来引用它们.)
- 右键单击“小部件”选项卡，然后选择“查看代码”
- 将以下代码粘贴到工作表的“代码”窗口中：
。
Private Sub Worksheet_Change(ByBal Target as Range)
On Error GoTo procErr
process_change Target
Exit Sub
procErr:
MsgBox "Got an error: " & Err.Description
Err.Clear
Application.EnableEvents = True
End Sub`
- 对每个“数据”工作表重复上述步骤：“事物”和“东西”（但不适用于“摘要”）
- 当 Visual Basic 编辑器打开时（您在此处进行所有粘贴操作），使用 Insert->Module 在工作簿中插入一个新代码模块
- 将以下代码粘贴到您创建的模块中：
.
Option Explicit
Sub process_change(ByVal Target As Range)
' when a cell is changed on one of the worksheets, this function is called
' it copies the most recently changed row
' and inserts it on the second line of the "summary" worksheet
' right below the headers
' if the headers include "changed by" and/or "last changed" (exactly)
' then that column will be updated with the (windows) user name and date, respectively
' similarly, if a column named "source" exists, it will contain the address of the row
' (sheet name / row number). In that case, if there was an earlier occurrence of the same row
' (multiple edits), the earlier occurence is removed
' you may use this code as is - but there is no warranty as to its useability
Dim s1 As Worksheet, s2 As Worksheet
Dim srcAddress As String
Dim oldSelection As Range
' don't update screen during processing - prevent "flickering"
Application.ScreenUpdating = False ' set to True when debugging
' don't accept events until we're done
Application.EnableEvents = False
' store old selection
Set oldSelection = Selection
Dim ri As Integer ' index of changed row
Dim rowAddress As String
ri = Target.Row
rowAddress = ri & ":" & ri ' address of changed row
if ri = 1 Then
Application.EnableEvents = True
Exit Sub ' don't record changes to the headers
End If
Range(rowAddress).Select
Selection.Copy ' copy changed row
Set s1 = ActiveSheet ' know where we will go back to
srcAddress = s1.Name & ":row" & ri ' full address to be used later
Set s2 = ActiveWorkbook.Sheets("summary")
s2.Range("2:2").Insert ' add a row at the top of the list
s2.Select ' activate sheet where we want to paste
Range("A2").Select ' leftmost cell of column
ActiveSheet.Paste ' paste the entire changed row
' optionally, we can add "source", "last changed" and "changed by"
' we do this if appropriately named columns exist
' slightly clumsy code to catch errors...
Dim lcCol
If Not IsError(Application.Match("last changed", Range("1:1"), 0)) Then
lcCol = Application.Match("last changed", Range("1:1"), 0)
Range("A2").Offset(0, lcCol - 1).Value = Date
End If
Dim cbCol
If Not IsError(Application.Match("changed by", Range("1:1"), 0)) Then
cbCol = Application.Match("changed by", Range("1:1"), 0)
Range("A2").Offset(0, cbCol - 1).Value = UserName
End If
Dim srcCol
If Not IsError(Application.Match("source", Range("1:1"), 0)) Then
srcCol = Application.Match("source", Range("1:1"), 0)
' find earlier entry regarding this row...
Columns("A:A").Offset(0, srcCol - 1).Select
Dim sf As Range
Set sf = Selection.Find(What:=srcAddress, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not sf Is Nothing Then
ri = sf.Row
rowAddress = ri & ":" & ri ' address of changed row
Range(rowAddress).Select
Selection.Delete
End If
Range("A2").Offset(0, srcCol - 1).Value = srcAddress
End If
s1.Activate ' go back to original worksheet
Application.CutCopyMode = False ' get rid of the "marching ants"
oldSelection.Select ' select the previous selection "like nothing happened"
' and turn on screenupdating and events...
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub eventsOn()
Application.EnableEvents = True
End Sub
Public Function UserName()
' note - this function only works on PC
UserName = Environ$("UserName")
End Function
完成所有这些后，您现在可以在工作表中放置标题 - 在所有四个工作表中使用相同的列标题。在第一个（摘要）表中，您可以选择再添加三个标题：这些标题不应与您使用的其他标题相同，并且被称为（确切地 - 没有额外的空格，大写，...）：source，@ 987654327@，changed by。
如果最后三个列标题不存在，则行为如下：
每次您对三个工作表中的一个进行更改时，所做更改的行将被复制到摘要表的第一行，标题下方。其他所有内容都会下移一排。
如果您添加“来源”列，将会发生两件事：来源（工作表名称：行号）将添加到该列中，并且将删除同一来源（同一行）的任何先前条目。因此，您只会看到给定行的“最新更改”。
如果添加“更改者”，您将获得最后一次更改的用户的名称； “上次更改”标题将包含上次更改的日期。
如果您能从这里解决问题，请告诉我 - 如果您遇到困难，请使用我在上面链接的示例电子表格来指导您。