【原】Excel VBA 合并文件夹下所有EXCEL明细表

您可以通过以下方式支持我：1、关注、点赞、留言、分享、打赏；2、点击广告、购买我的安利微店产品；3、添加我的合谷医疗企业微信，谢谢！

☆本期内容概要☆

• 明细表合并为一张总表

大家好，我是冷水泡茶，前期我们分享了（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，则表示数据有标题行，从第二个表开始我们从第二行开始复制。

另外，关于拆分功能，以前的代码会把拆分项目中空白的记录剔除，则变相要求拆分项目不能有空白，今天想来其实有空白项目也无所谓，把空白的项目作为一个组拆分不就可以了吗？于是稍微修改了一下代码。