一、问题

工作需要将多个小的excel文件合并成为一个excel文件，文件格式、内容一致，因为文件数目较多，不考虑手动粘贴复制，直接考虑使用VBA程序解决这个问题。

                                                            图1 同一个文件夹下的多个excel文件

二、代码

Sub 打开文件夹下所有文件并复制制定内容()

Dim a$, n As Long, i As Long, Num As Long, Name$   
‘定义n为计算写入的起始行号,Num为文件计数,n最好设为长整型，不然容易溢出

Dim h%
‘h定义为除首行（字段名）的内容行数

Dim mypath$

t = Timer

Application.ScreenUpdating = False

mypath = ActiveWorkbook.Path
‘获取当前宏文件所在问价夹路径

a = Dir(mypath & “\” & “*.xls”)
‘获取当前文件夹下文件路径

Workbooks.Open mypath & “\” & a ‘遍历文件

Workbooks(a).Activate

i = Sheets(“Sheet0”).Range(“a65536”).End(xlUp).Row
‘这里.xls最大行数只能是65536

Workbooks(a).Sheets(“Sheet0”).Range(“A2”, “P” & i).Copy Workbooks(“汇总”).Sheets(“汇总”).Range(“A2”)

Workbooks(“汇总”).Sheets(“汇总”).Range(“Q2”, “Q” & i) = a

Workbooks(a).Close

Num = 1

Name = Left(a, Len(a) – 4)

Do

a = Dir

 If a <> “” And a <> “汇总.xlsm” Then

    Workbooks.Open mypath & “\” & a

    n = Workbooks(“汇总”).Sheets(“汇总”).Range(“a1048576”).End(xlUp).Row + 1

    Workbooks(a).Activate

    i = Workbooks(a).Sheets(“Sheet0”).Range(“a65536”).End(xlUp).Row

    Workbooks(a).Sheets(“Sheet0”).Range(“A2”, “P” & i).Copy Workbooks(“汇总”).Sheets(“汇总”).Range(“A” & n)

    Workbooks(“汇总”).Sheets(“汇总”).Range(“Q” & n, “Q” & n + i – 2) = a

    Workbooks(a).Close

    Num = Num + 1

    Name = Name & Left(a, Len(a) – 4)

‘    MsgBox “共合并：” & Num & “个文件！”

 Else

    MsgBox “共合并：” & Num & “个文件！” & “共用时：” & (Timer – t) & “s”

    Exit Sub

 End If

Loop

End Sub