【添加详尽注释】Excel VBA合并不同工作簿所有工作表到一张工作表

总结CSDN的一个分享，为了方便理解，增加注释，可根据注释修改以满足各种实际用途。

原分享见最下方链接。Excel VBA合并不同工作簿所有工作表到一张工作表_pan na的博客-CSDN博客_vba多表合并到一张表格

Sub 合并当前目录下所有工作簿的全部工作表()

'声明变量
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long, k As Integer
Dim Num As Long
Dim BOX As String

'关闭屏幕刷新，提升速度
Application.ScreenUpdating = False

'合并该宏代码所在文件的文件夹，先获取路径
MyPath = ActiveWorkbook.Path

'赋值，Dir函数，语法为“Dir [ (pathname, [ attributes ] ) ]”，
'返回一个 String，它表示与指定模式或文件属性或驱动器的卷标匹配的文件、目录或文件夹的名称
'用到了*取代若干字符实现模糊检索，使得MyName成为当前路径下的所有包含".xls"文件名的集合

MyName = Dir(MyPath & "\" & "*.xls*")

AWbName = ActiveWorkbook.Name

Num = 0

ii = 0

Do While MyName <> ""

    If MyName <> AWbName Then '对于所有当前路径下的excel文件而不是当前工作簿的文件，执行后续代码（复制）
        
        'Workbooks.Open是workbooks的一个方法，表示打开文件，打开的是前述获取了的文件名的文件
        Set Wb = Workbooks.Open(MyPath & "\" & MyName)

        Num = Num + 1
        
        'with 语句：对单个对象或用户定义类型执行一系列语句，可以帮助简化代码
            '本来要写成“Workbooks(1).ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row + 1”
            '因为前面有了个with Workbooks(1).ActiveSheet 就可以简写成“.Range("B" & Rows.Count).End(xlUp).Row + 1”
            
        With Workbooks(1).ActiveSheet
        
            '获取要合并的工作簿名称，放置到当前文件的单元格（第1列，B列最大行号+1）中
            '由于用cells()表示单元格时语法为cells(行号,列号）
            '因此：
            '如果要更换行号，受制于每次补充必须要在之前合并的行之后，是变动的，建议引用一个变量。
                '在“Do While MyName <> ""”的循环前，先把变量赋值为需要开始复制的行号。
                '在循环末尾“Loop”前对变量赋值为.Range("B" & Rows.Count).End(xlUp).Row + 1
            '如果要更换列，把“1"改成其他列即可，用数字表示
            .Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 1) = Left(MyName, Len(MyName) - 4)
            
            '对该工作簿的每个工作表复制
            '如果只要复制第一个工作表:
                '就可以不用G这个变量及这个子循环，删除"For G = 1 To Sheets.Count"和“next",并把sheets(G)改为sheets（1）
            '如果只要复制指定名称的1个工作表:
                '就可以不用G这个变量及这个子循环，删除"For G = 1 To Sheets.Count"和“next",并把sheets(G)改为sheets（"指定名"）
            For G = 1 To Sheets.Count

                k = k + 1

                If k = 1 Then '如果第一次复制，被复制文件就进行复制前面几行标题栏

                    '第一次复制是从第一行开始黏贴，复制到当前工作表的单元格区域，单元格区域的最左上角为单元格（第2列，B列最大行号+1）
                    '因为第一行已经放了复制的表格名称
                    
                    '复制的是已使用的单元格区域，如果要复制指定的行列：
                    '就把UsedRange更改为Range("A1:D4")，range里面的内容根据需求修改,下面else也要对应改
                    '如果是复制指定几列，则更改为Columns("A:D")，Columns里面的内容根据需求修改,下面else也要对应改
                    Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B" & Rows.Count).End(xlUp).Row, 2)
                    
                    '刷新当前表格B列的最大行号，以便继续复制，如果不是贴到B列，要取复制到的列的最大行号（这列要非空，否则有行会被替换）
                    '实际这行代码在整个代码里没有用途，可以删掉。只是以便于万一要引用，例如在前面那行COPY的代码中用ii替换.Range("B" & Rows.Count).End(xlUp).Row
                    ii = .Range("B" & Rows.Count).End(xlUp).Row
                    
                '不是第一次复制:

                Else
                 '从有数行的下一行开始黏贴
                '下移三行（假设标题栏三行） .下行代码中的Offset(3) 就是下移三行再复制，所以要下移几行改这个3为几就可以了
                    Wb.Sheets(G).UsedRange.Offset(3).Copy .Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 2)

                    ii = .Range("B" & Rows.Count).End(xlUp).Row

                'IF和Then不同行，则要在IF结束后写End if才完整，否则会提示“IF没有END”，如果IF语句和THen语句在同一行则不需要
                End If

            Next 'For循环的结尾
            
            '装入已汇总的工作簿名称，以便在后面的弹窗MsgBox中显示，如果不需要显示，可以删除这行，并在MsgBox中删除相应引用
            WbN = WbN & Chr(13) & Wb.Name
            
            '关闭掉复制的这个工作簿
            Wb.Close False

        End With 'With语句的结尾，和前面“With Workbooks(1).ActiveSheet”对应

    End If 'IF 语句的结尾，'和前面"  If MyName <> AWbName Then"对应

    MyName = Dir

Loop 'Do While循环的结尾

Range("B1").Select

'执行完毕，打开刷新（最开始为了提高效率关闭了刷新）
Application.ScreenUpdating = True

'输出提示
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"

End Sub