在坚持等放假，给大家提供一个小工具，实现Excel或者CSV多文件合并
地址：
https://wws.lanzous.com/iYkLcljicch
合并后会在文档目录生成一个Summary的汇总文档
合并说明：
1，把需要合并的文档放置在一个文件夹里。
2，如果选择合并模式2（合并至工作表Sheet），要求合并的文档表格结构完全一致。（即标题顺序一致）
需要学习代码的，代码如下。
Option Explicit
Sub sMergeWorkBook()
Dim sPath$, sName$, sMsg$, sMode$, sFirstFile$
Dim fileCount&, lastRow&, lastCol&, sLastRow&
Dim newWB As Workbook
Dim SumWB As Workbook
Dim SumSht As Worksheet
Dim SumRng As Range
Dim fileNameRng As Range
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "请选择文件目录！", vbCritical, "你没有选择文件夹"
Exit Sub
End If
sPath = .SelectedItems(1) & ""
End With
Application.DisplayAlerts = False
If Len(Dir(sPath & "Summary.xlsx")) > 0 Then Kill sPath & "Summary.xlsx"
Application.DisplayAlerts = True
sName = Dir(sPath & Sheet1.[h10])
If Len(sName) > 0 Then
sMsg = "请选择合并方式：" & vbNewLine + vbNewLine & _
"1-合并至工作簿（workBook）" & vbNewLine & _
"2-合并至工作表（Sheet）" & vbNewLine + vbNewLine
sMode = Application.InputBox(sMsg, "请选择合并类型", "1")
If Not (sMode = "1" Or sMode = "2") Then
MsgBox "合并方式错误！", vbCritical, "Warning！"
Exit Sub
End If
Application.ScreenUpdating = False
sFirstFile = sName
Do
fileCount = fileCount + 1
Set newWB = Workbooks.Open(sPath & sName)
If SumWB Is Nothing Then
newWB.ActiveSheet.Copy
Set SumWB = ActiveWorkbook
If sMode = "2" Then
Set SumSht = SumWB.ActiveSheet
SumSht.Name = "汇总数据"
With SumSht '第一次合并，新增一列，记录文档来源名称
.Columns(1).Insert shift:=xlShiftToRight '新增一列，记录文档名称
sLastRow = .Cells.Find("*", , , , 1, 2).Row
Set fileNameRng = .Cells(2, 1).Resize(sLastRow - 1)
End With
fileNameRng = newWB.Name '来源文档名称
End If
Else
If sMode = "1" Then
newWB.ActiveSheet.Copy before:=SumWB.Sheets(1)
Else
With newWB.ActiveSheet
lastRow = .Cells.Find("*", , , , 1, 2).Row
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
sLastRow = SumSht.Cells.Find("*", , , , 1, 2).Row
If lastRow > 1 Then
.Cells(2, 1).Resize(lastRow - 1, lastCol).Copy _
SumSht.Cells(sLastRow + 1, 2) '注意粘贴到汇总表要右移一列，第一列为文档名称列
Application.CutCopyMode = False
Set fileNameRng = SumSht.Cells(sLastRow + 1, 1).Resize(lastRow - 1) '再次粘贴来源文档名称
fileNameRng = newWB.Name
End If
End With
End If
End If
newWB.Close False
sName = Dir
Loop While Len(sName) > 0 And sName <> sFirstFile
If Not SumWB Is Nothing Then
With SumWB
If sMode = "2" Then
With SumSht
.Columns(1).Insert shift:=xlShiftToRight
sLastRow = .Cells.Find("*", , , , 1, 2).Row
Set SumRng = .Cells(2, 1).Resize(sLastRow - 1)
End With
SumRng = "=Row()-1"
SumRng = SumRng.Value
End If
.SaveAs sPath & "Summary.xlsx"
.Close
End With
End If
Application.ScreenUpdating = True
If fileCount > 0 Then
MsgBox "成功合并 " & fileCount & " 个数据文件！" & vbNewLine + vbNewLine & _
"请于文件夹目录查阅文档“Summary”", vbInformation, "合并成功"
End If
Else
MsgBox "未找到指定的Excel文件！请检查后缀名。", vbCritical, "Warning!"
End If
Set SumRng = Nothing
Set SumSht = Nothing
Set newWB = Nothing
Set SumWB = Nothing
End Sub
