操作步骤
1.打开任一汇总收集表
2.若有宏安全性提醒，选择信任并启用宏
3.点击“汇总收集表按钮”
4.选择原文件，汇总文件保存路径的提示直接点击确定即可。
5.选择收集到的文件
6.提示：汇总完成，点击确定关闭文件即可。
注：无修改静默版不显示操作过程，不修改收集的文件格式；有修改刷新版显示操作过程并标记出修改的位置。
VBA代码
Sub 汇总收集表()
On Error Resume Next
Application.ScreenUpdating = False
Dim oldFilePath As String
Dim newFilePath As String
Dim oldworkbook As Workbook
Dim newworkbook As Workbook
Dim oldSheet As Worksheet
Dim newSheet As Worksheet
Dim oldCell As Range
Dim newCell As Range
Dim SelectedFile As Variant
Dim OriginalFilePath As String
Dim OriginalFileName As String
Dim NewFileName As String
'选择原文件'
1
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "选择原文件"
If .Show <> -1 Then
If MsgBox("未选择文件，是否重新选择", vbOKCancel) = vbOK Then
GoTo 1
Else
End
End If
End If
Set oldworkbook = Workbooks.Open(.SelectedItems(1))
OriginalFilePath = oldworkbook.Path
OriginalFileName = oldworkbook.Name
NewFileName = "汇总文件-" & OriginalFileName
MsgBox "汇总文件将保存在原路径中，文件名为：" & NewFileName & ""
End With
'选择新文件'
2
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "选择新文件"
.AllowMultiSelect = True
If .Show <> -1 Then
If MsgBox("未选择文件，是否重新选择", vbOKCancel) = vbOK Then
GoTo 2
Else
oldworkbook.Close SaveChanges:=False
End
End If
End If
For Each SelectedFile In .SelectedItems
Set newworkbook = Workbooks.Open(SelectedFile)
' 比较每个工作表中的单元格 '
For Each newSheet In newworkbook.Sheets
Set oldSheet = oldworkbook.Sheets(newSheet.Name)
' 比较每个单元格的值 '
For Each newCell In newSheet.UsedRange
Set oldCell = oldSheet.Range(newCell.Address)
' 如果原文件单元格为空，则在原文件中填入新文件内容 '
If oldCell.Value = "" Then
oldCell.Value = newCell.Value
newCell.Interior.Color = RGB(255, 0, 0) ' 标记为红色 '
End If
Next newCell
Next newSheet
newworkbook.Close SaveChanges:=False
Next SelectedFile
End With
' 关闭文件 '
oldworkbook.SaveAs Filename:=OriginalFilePath & "\" & NewFileName
oldworkbook.Close SaveChanges:=False
' 提示比较完成 '
MsgBox "数据汇总完成！"
ThisWorkbook.Close
End Sub
