利用VBA快速整合多个excel文件

心得(一)：关于VBA如何把同一个文件下的所有文件的内容合并到同一个excel文件下

问题：如何把多个格式相同的excel整合到一个excel上，起初想的是可以直接用复制粘贴……但是文件有几百个将近一千个，这么做的话有点暴躁…

解决：首先把所有要整合的excel文件放在一个路径不含有中文名的目录下，然后新建一个excel文件右键sheet点击查看代码，这时候你的画面上会出现一个编辑器，你这这上面利用VBA编写语言，最后点击F5直接运行即可

正常解决思路：
打开一个excel文件，并将需要的内容复制，然后粘贴到整合excel文件上，并不断重复这样的操作。

利用VBA操作：

1. 利用VBA打开文件，代码如下：
   
   括号内的是打开文件的绝对地址

2. 复制选定区域的内容：
   

3. 粘贴复制的内容到指定的文件
   

4. 利用VBA的dir函数打开下一个文件，这个函数会根据一定规律打开文件内的文件，但是具体是什么规律暂时还不知道，
   这个函数如果是这个方式：
   
   第首次使用就要输入绝对地址，但是后面就不需要了

源码如下：

Sub 合并当前目录下所有工作簿的全部工作表()
'表示当前的过程的名称

'定义对应的变量名称
Dim mypath, myname, awbname
Dim wb As Workbook, wbn As String
Dim g As Long
Dim num As Long
Dim box As String
Dim count As Long
Dim place As Long
Dim temp As Long

'关闭excel的刷新
Application.ScreenUpdating = False

'禁止弹出对话框
Application.DisplayAlerts = False

'得到本文件的相对地址
mypath = ActiveWorkbook.Path

'得到这个文件夹下的某个文件的文件名
myname = Dir(mypath & "\" & "*.xls")

'当前工作的excel的文件名
awbname = ActiveWorkbook.Name

num = 0
place = 3

'如果当前的文件名为空的字符串（""）表示已经没有更多的文件了跳出循环
Do While myname <> ""
    '需要的就是下面这个条件，每个文件名都不一样
    If myname <> awbname Then
        '把每一个文件都打开
        Set wb = Workbooks.Open(mypath & "\" & myname)
        num = num + 1
		'计算非空行数量
		count = application.counta(range("c:c"))
		'MsgBox count
		
		wb.Sheets(1).Range("a5", wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell)).Copy
		'从a5开始到已用区域最后一个单元格的范围全部复制
        ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Range("C65536").End(xlUp).Row + 2 , 1).PasteSpecial Paste:=xlValues
		'从c列最后一个有数据的单元格后的空格开始粘贴
		
		'下面开始合并需要的单元格
		temp = count + place - 2
		ThisWorkbook.Sheets(1).Range("A" & place & ":A" & temp).Merge
		ThisWorkbook.Sheets(1).Range("B" & place & ":B" & temp).Merge
		ThisWorkbook.Sheets(1).Range("H" & place & ":H" & temp).Merge
		ThisWorkbook.Sheets(1).Range("I" & place & ":I" & temp).Merge
		
		'对每个队伍重新编号
		ThisWorkbook.Sheets(1).Range("A" & place).Value = num
		place = place + count
        wbn = wbn & Chr(13) & wb.Name
        wb.Close False
		
    End If
myname = Dir
Loop
Range("a1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "共合并了" & num & "个工作薄下的全部工作表。'如下：" & Chr(13) & wbn, vbInformation, "提示"
End Sub