本文于2023年6月19日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
☆本期内容概要☆
明细表合并为一张总表
大家好，我是冷水泡茶，前期我们分享了（Excel VBA 总表按项目拆分明细表/考勤表按部门拆分为单独文件），我在网上看到过不少人想把明细表汇总到一张表上，于是我灵机一动，把我们拆分出来的明细表再合并起来。
接下来，我们一起来看一下如何实现：
1、借着前期拆分的文件，我们在Sheets("Main")上面添加“合并”按钮，“明细数据有标题”复选框。
2、插入模块，添加合并代码：
Sub CombineFiles() Dim dataFolder Dim FileSystem As Object Dim folder As Object Dim FileExtn As String Dim lastRow As Integer, lastCol As Integer Dim rng As Range Dim ws As Worksheet Dim wb As Workbook Dim CombineSheet As Worksheet Dim t As Integer Dim blnCkb As Boolean Application.ScreenUpdating = False blnCkb = ThisWorkbook.Sheets("Main").CkbWithTitle '创建 "CombineSheet" 工作表 On Error Resume Next Set CombineSheet = ThisWorkbook.Worksheets("合并") On Error GoTo 0 If CombineSheet Is Nothing Then '创建新的工作表 Set sht = ThisWorkbook.Worksheets.Add sht.Name = "合并" Set CombineSheet = sht Else CombineSheet.Cells.Clear End If On Error Resume Next With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then dataFolder = .SelectedItems(1) Else Exit Sub End If End With Set FileSystem = CreateObject("Scripting.FileSystemObject") Set folder = FileSystem.GetFolder(dataFolder) For Each file In folder.Files FileExtn = Right(file.Name, Len(file.Name) - InStrRev(file.Name, ".") + 1) If FileExtn = ".xlsx" Or FileExtn = ".xls" Then Set wb = Workbooks.Open(file.Path) For Each ws In wb.Sheets If t = 0 Then ws.UsedRange.Copy CombineSheet.Cells(1, 1) Else lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row lastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column If blnCkb Then Set rng = ws.Range(Cells(2, 1), Cells(lastRow, lastCol)) Else Set rng = ws.Range(Cells(1, 1), Cells(lastRow, lastCol)) End If rng.Copy CombineSheet.Cells(CombineSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) End If t = t + 1 Next wb.Close savechanges:=False End If Next ThisWorkbook.Save Application.ScreenUpdating = True MsgBox "成功合并【" & t & "】个明细表！"End Sub
代码解析：代码不算长，但涉及的技术要点还是比较多的。
1、检查有无“合并”表，有则清除内容，无则添加
2、获取打开的文件夹路径
3、遍历文件夹下所有“.xlsx”、“.xls”文件
4、这里变量t的作用有两个，一是当打开第一个工作表时，我们复制数据包括表头，简单来讲就把所有已使用过的单元格区域都复制过来。二是作为计数器，统计复制了多少个表。
5、根据复选框的值，如果为TRUE，则表示数据有标题行，从第二个表开始我们从第二行开始复制。
另外，关于拆分功能，以前的代码会把拆分项目中空白的记录剔除，则变相要求拆分项目不能有空白，今天想来其实有空白项目也无所谓，把空白的项目作为一个组拆分不就可以了吗？于是稍微修改了一下代码。
好，今天就到这吧。欢迎点赞、留言、分享，谢谢大家，我们下期再会。