使用excel中的VBA合并多个excel文件

需求是这样的：
在Windows下，用excel文件让多个小组填写了统计信息，现在我需要把收集的多个文件汇总到一个文件中，前三行为标题可以忽略，第四行为收集信息的列名，处理每一行数据的时候，发现某一行的第一列为空将不再复制处理本文件中下面的行。
在office的Excel中视图下面的宏中，创建一个新的宏，并命名为ConsolidateExcelFiles，

Sub ConsolidateExcelFiles()Dim FolderPath As StringDim FileName As StringDim wbSource As WorkbookDim wsSource As WorksheetDim wsDest As WorksheetDim LastRow As LongDim DestRow As LongDim i As LongDim fd As FileDialogDim FirstFile As BooleanDim HeaderRow As LongDim StartRow As Long' 使用文件对话框选择文件夹路径Set fd = Application.FileDialog(msoFileDialogFolderPicker)fd.Title = "选择要合并的文件所在的文件夹"If fd.Show = -1 ThenFolderPath = fd.SelectedItems(1) & "\"ElseMsgBox "未选择文件夹，操作取消。"Exit SubEnd If' 询问用户列名所在的行号HeaderRow = Application.InputBox("请输入列名所在的行号：", Type:=1)If HeaderRow < 1 ThenMsgBox "无效的行号，操作取消。"Exit SubEnd If' 创建一个新的工作簿用于汇总Set wsDest = ThisWorkbook.Sheets(1)DestRow = 1FirstFile = True' 获取文件夹中的第一个文件FileName = Dir(FolderPath & "*.xls*")' 遍历文件夹中的所有文件Do While FileName <> ""' 打开源工作簿Set wbSource = Workbooks.Open(FolderPath & FileName)Set wsSource = wbSource.Sheets(1)' 找到源工作表的最后一行LastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row' 如果是第一个文件，复制列名If FirstFile ThenwsSource.Rows(HeaderRow).Copy wsDest.Rows(DestRow)DestRow = DestRow + 1FirstFile = FalseEnd If' 从列名行的下一行开始复制数据StartRow = HeaderRow + 1For i = StartRow To LastRow' 如果第一列为空，则停止处理该文件If IsEmpty(wsSource.Cells(i, 1).Value) Then Exit For' 复制数据到目标工作表wsSource.Rows(i).Copy wsDest.Rows(DestRow)DestRow = DestRow + 1Next i' 关闭源工作簿wbSource.Close SaveChanges:=False' 获取下一个文件FileName = DirLoopMsgBox "汇总完成！"
End Sub

这里的VBA脚本通过文件夹选择的方式来选择要合并哪个文件夹下面的Excel文件
在这里插入图片描述
然后输入收集信息表中列名所在的行数：

最后合并的文件中只会记录一行列名，后面其他重复的列名将会被忽略掉：