Sub 合并目录所有工作簿全部工作表()

Dim MP, MN, AW, Wbn, wn '定义变量（MP=MyPath，MN=MyName，AW=ActiveWorkbookName，Wbn=WorkBookName,wn=workbooksheet(i)name）,但未指定变量类型，这样不是很规范

Dim Wb As Workbook '定义变量Wb为工作簿类型 'Dim Wbn As string，G As Long '定义变量Wbn为字符型,G为长整型 'Dim Num,ini As Long '定义Num未声明类型，定义并声明ini为长整型

Dim i, a, b, d, c, e '定义变量,但未指定变量类型，这样不是很规范

Application.ScreenUpdating = False '关闭屏幕刷新

MP = ActiveWorkbook.Path '将当前工作簿（活动工作簿）的路径赋值给MP

MN = Dir(MP & "\" & "*.xls") '将当前工作簿（活动工作簿）的路径加上\*.xls后缀,从而捕获到的*位置的所有文件名的值，Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。

AW = ActiveWorkbook.Name '将当前工作簿（活动工作簿）的名字赋值给AW（不带后缀，只是名字）

Num = 0 'Num=0

e = 1 'ini=0

Do While MN <> "" '运行下面的DO while 循环，直到MN值为空值

    If MN <> AW Then '如果，MN值不等于AW值，就运行IF到END IF之间的判断语句

        Set Wb = Workbooks.Open(MP & "\" & MN) '打开MP\路径下名为MN变量值的工作簿，并引用（Set的作用）赋给Wb ''引用赋值如果，对Wb更改了，被引用的也随着更改了，详细见下边PS（3）

        a = a + 1 '对a进行循环累加

        With Workbooks(1).ActiveSheet '对已打开的所有工作簿中的第一个工作簿中的被激活的工作表运用with语句

            For i = 1 To Sheets.Count '在Workbooks(1).ActiveSheet的所有sheet中循环

                If Sheets(i).Range("a1") <> "" Then '如果Wb工作簿的第i个工作表的A1单元格内容不为空，就进行IF判断内容，如果为空，跳过IF判断进入For的下一个循环

                    Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1) '将wb工作簿中第i个工作表的A1单元格区域扩充为一行，有应用痕迹列数（x）大小的区域，即A1：x1区域， 扩充后区域内的内容复制到Workbooks(1).ActiveSheet的A1位置

                    d = Wb.Sheets(i).UsedRange.Columns.Count 'wb工作簿的第i工作表有应用痕迹的列计数，并赋值给d

                    c = Wb.Sheets(i).UsedRange.Rows.Count - 1 'wb工作簿的第i工作表有应用痕迹的行计数，并赋值给c

                    wn = Wb.Sheets(i).Name 'wb工作簿的第i个工作表的名字赋值给wn

                    .Cells(1, d + 1) = "表名" 'Workbooks(1).ActiveSheet工作表的第1行，第d+1列单元格填充“表名”字符串

                    .Cells(e + 1, d + 1).Resize(c, 1) = MN & wn 'Workbooks(1).ActiveSheet工作表的第e+1行，第d+1列区域扩充为c行，1列区域，并在该区域填充为MN & wn

                    e = e + c

                    Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1) '将区域内容，复制到Workbooks(1).ActiveSheet中，每次从Workbooks(1).ActiveSheet的最后一个非空行开始粘贴

                End If

            Next

            Wbn = Wbn & Chr(13) & Wb.Name '将Wbn的值加上空格和Wb工作簿的名称后赋值给Wbn

            Wb.Close False '将Wb工作簿关闭

        End With

    End If

MN = Dir '获得上边Dir匹配到的下一次文件名；'Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。

Loop

Range("a1").Select '选中当前工作簿的第一个单元格

Application.ScreenUpdating = True '开启屏幕刷新

MsgBox "共合并了" & a & "个工作薄下全部工作表。如下：" & Chr(13) & Wbn, vbInformation, "提示" '给出最后提示

End Sub