编程将几个excel文件合并成一个，即如何将几个excel文件变成一个book里的几个sheet页

小弟最近编程，生成了几个excel文件，现在想把这几个excel文件变成一个book里的几个sheet页，不知道如何来操作。望大家指教。越简单越好！

5 个解决方案

#1

Option Explicit

Private Sub btnTotal_Click()
    Dim sPath As String
    Dim bErr As Boolean
    Dim sErr As String

    sPath = ActiveWorkbook.Path
    '遍历目录
    bErr = bSearch(sPath, sErr)

    '错误消息处理
    If bErr = False Then
        MsgBox sErr
    End If

    '清空剪贴板
    Application.CutCopyMode = False
End Sub

Private Function bSearch(ByVal sPath As String, ByRef sErr As String) As Boolean
    Dim objFolders As New FileSystemObject
    Dim objFolder As Folder
    Dim objFiles As Files
    Dim objFile As File
    Dim index As Integer
    Dim bErr As Boolean
    Dim objWorksheet As Worksheet

    On Error GoTo ErrorHandler:

    bSearch = False

    Set objFolder = objFolders.GetFolder(sPath)
    Set objFiles = objFolder.Files

    '查找当前sheet数
    index = 0
    For Each objWorksheet In Worksheets
        index = index + 1
    Next objWorksheet

    '查找目录下文件
    For Each objFile In objFiles
        If objFile.Name <> ThisWorkbook.Name Then
        '添加工作表
        bErr = copySheet(objFile.Name, sPath, index, sErr)
        If bErr = False Then
            Set objFolder = Nothing
            Set objFiles = Nothing
            sErr = sErr
            bSearch = False
            Exit Function
        End If
        index = index + 1
        End If
    Next

    Set objFolder = Nothing
    Set objFiles = Nothing

    bSearch = True
    Exit Function

ErrorHandler:
    Set objFolder = Nothing
    Set objFiles = Nothing
    sErr = Err.Number & Err.Description
    bSearch = False

End Function

Private Function copySheet(ByVal FileName As String, ByVal sPath As String, ByVal index As Integer, ByRef sErr As String) As Boolean
    Dim objWorksheet As Worksheet
    Dim strWsName As String
    Dim objSheet As Sheet2
    Dim FilePath As String

    On Error GoTo ErrorHandler:

    copySheet = False
    '考贝工作表
    FilePath = sPath & "\" & FileName
    Workbooks.Open sPath & "\" & FileName
    For Each objWorksheet In Worksheets
        strWsName = objWorksheet.Name
    Next objWorksheet

    Windows(FileName).Activate
    Sheets(strWsName).Copy After:=Workbooks(ThisWorkbook.Name).Sheets(index)

    '关闭活动窗口
    Excel.Workbooks(FileName).Close False

    copySheet = True
    Exit Function

ErrorHandler:
    sErr = Err.Number & Err.Description
    copySheet = False
End Function
这是我刚纳品的项目中的部分代码，可以实现你的要求
注：其中一个excel作为主文件，写入代码，其余文件必须和主文件在同一目录下
    所有文件只保留一个sheet,否则会出bug

#2

楼主，好不好用，回个话啊

#3

哈哈，不好意思，看的晚了点。不过我是想让它在后台运行，最好是C++代码或C#代码之类的，自己搞了一点，没弄好。所以求助。谢谢楼上。

#4

代码太长了一点吧... ...

#5

代码太长了一点吧... ...
--------------------------
哪段有冗余，请独孤兄指教，谢谢

#1

#2