vba合并一个目录下的指定文件名的多个excel文件为一个excel

Question

本帖最后由 xzlhsjy 于 2014-04-28 17:26:57 编辑

Answer 1

Option ExplicitSub 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 SubSub 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

Answer 2

还有我想问下你，执行完之后合并的excel是在什么目录下？看你的代码都没有指定目录的

Answer 3

1、错误是要引用 Microsoft Scripting Runtime 库
2、合并后，就是当前打开的Excel 啊，如果你要另存，就在Uion()中for...next后面加一个 ThisWorkbook.SaveAs “路径"

Answer 4

我研究研究..
Application.Visible=False

Answer 5

我研究研究..
Application.Visible=False谢谢，赵大牛..