vba归拢一个目录下的指定文件名的多个excel文件为一个excel

vba合并一个目录下的指定文件名的多个excel文件为一个excel
我有一个需求：就是用vba实现把一个目录下（D:\test）（包括子目录下）文件名为test开头的excel文件（如：test20140404.xlsx）全部复制到一个新目录下（如：E:\test），并把这些excel文件内容合并到一个新的excel文件里！
求高手写出代码赐教
------解决方案--------------------

Option Explicit


Sub union()

    Dim fso As FileSystemObject, tFolder As Folder, tFile As File

    Dim fName As String

    

'    On Error GoTo hErr

    Set fso = New FileSystemObject

    Set tFolder = fso.GetFolder(ThisWorkbook.Path)  ' 文件夹路径

    Application.ScreenUpdating = False

    For Each tFile In tFolder.Files

        fName = tFile.Name

        If Right(fName, 5) = ".xlsx" Then       '判断条件

            If InStr(fName, "test") > 0 Then    '判断条件

                Call CopySheets(tFile.Path, fName)  '拷贝工作表

            End If

        End If

    Next

    Application.ScreenUpdating = True

    Set tFile = Nothing

    Set tFolder = Nothing

    Set fso = Nothing

    Exit Sub

'hErr:

'    Set tFile = Nothing

'    Set tFolder = Nothing

'    Set fso = Nothing

'    MsgBox "error in union()"

End Sub


Sub CopySheets(ByVal fPath As String, ByVal fName As String)

    Dim tWB As Workbook, tWS As Worksheet

'    On Error GoTo hErr

    Application.ScreenUpdating = False

    Set tWB = Workbooks.Open(fPath, True, True)

    '循环拷贝工作表，并重命名

    For Each tWS In tWB.Worksheets

        tWS.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

        ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Mid(fName, 1, InStr(fName, ".")) & "_" & tWS.Name

    Next

    tWB.Close

    Application.ScreenUpdating = True

    Set tWS = Nothing

    Set tWB = Nothing

    Exit Sub

'hErr:

'    Set tWS = Nothing

'    Set tWB = Nothing

'    MsgBox "error in copysheets()"

End Sub

'--这是宏代码部分(union),功能差不多OK，具体的可能还需要调整
'--文件夹目录：test1.xlsx,test2.xlsx,union.xlsm