在Excel里如何将多个工作簿合并到一个工作簿中

2022-08-16 13:32:53

当你必须将多个工作簿合并到一个工作簿时，你遇到过麻烦吗？最让人心烦的就是需要合并的工作簿里有很多张工作表。有人能推荐方法解决这个问题吗？

利用VBA 将多个工作簿合并到一个工作簿中
复杂，高级用户使用

Excel 的专业用户可以使用VBA 将多个工作簿合并到一个主要的工作簿中。你可以按照如下步骤操作：

1. 将需要合并的所有工作簿都放置在同一个目录下。如图：

2. 打开一个工作簿，其他工作簿将被合并到这个工作簿中。

3. 点击开发工具 >> Visual Basic，Microsoft Visual Basic for applications 窗口将被打开，点击插入 >> 模块，将下面的代码输入模块窗口中：

VBA:将多个工作簿合并到一个工作簿中

Sub GetSheets()

Path = "C:\Users\dt\Desktop\dt kte\"

Filename = Dir(Path & "*.xls")

Do While Filename <> ""

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

For Each Sheet In ActiveWorkbook.Sheets

Sheet.Copy After:=ThisWorkbook.Sheets(1)

Next Sheet

Workbooks(Filename).Close

Filename = Dir()

Loop

End Sub

提示：在上面的代码里，你可以将目录路径更换成你自己使用的路径。

4. 然后点击按钮运行代码，工作簿里的全部工作表（包括空白工作表）都将被合并到主工作簿里。

注意：这个VBA 代码能将整个工作簿合并到主工作簿中，但是不能针对指定的工作表进行合并。

利用移动或复制功能将多个工作簿合并到一个工作簿中
操作耗时

利用移动或复制功能将多个工作簿合并到一个工作簿中

如果你只是Excel 新手，除了复制每张工作表里的内容再粘贴到新工作簿和应用移动或复制功能外，也没有其他选择了。应用移动或复制功能能帮你快速地将一张或多张工作表导出或复制到新工作簿里。

1. 打开所有需要合并的工作簿。

2. 在工作表标签栏上选中一个工作簿里的全部工作表名称。按住Ctrl 键或Shift 键，你可以同时选择多个工作表。右键点击工作表名称，从右键菜单里选择移动或复制。

3. 在移动或复制工作表对话框里，在将选定工作表移至工作簿下拉菜单里选择主工作簿，其他工作簿都将被合并到这个主工作簿中。然后指定合并工作表的位置。如图：

4.点击确定。选中的工作表都被合并到了主工作簿里。

5. 重复2-4步，将其他工作簿移到主要的工作簿里。这样，所有打开的工作簿中的工作表都被合并到了一个工作簿里。如图：

http://www.extendoffice.com/documents/excel/zh-cn-excel/2805-combine-multiple-workbooks.html

实践证明，下面的代码也很有效：(http://www.excelperfect.com/index.php/2009/05/23/mergesomeworkbooks/)

Sub CombineWorkbooks()

    Dim strFileName As String

    Dim wb As Workbook

    Dim ws As Object

 

    '包含工作簿的文件夹,可根据实际修改

    Const strFileDir As String = "D:\示例\数据记录\"

 

    Application.ScreenUpdating = False

 

    Set wb = Workbooks.Add(xlWorksheet)

    strFileName = Dir(strFileDir & "*.xls*")

 

    Do While strFileName <> vbNullString

        Dim wbOrig As Workbook

        Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)

        strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)

 

        For Each ws In wbOrig.Sheets

            ws.Copy After:=wb.Sheets(wb.Sheets.Count)

            If wbOrig.Sheets.Count > 1 Then

                wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index

            Else

                wb.Sheets(wb.Sheets.Count).Name = strFileName

            End If

        Next

 

        wbOrig.Close SaveChanges:=False

 

        strFileName = Dir

 

    Loop

 

    Application.DisplayAlerts = False

    wb.Sheets(1).Delete

    Application.DisplayAlerts = True

 

    Application.ScreenUpdating = True

 

    Set wb = Nothing

 

End Sub

码农公寓

利用移动或复制功能将多个工作簿合并到一个工作簿中

相关文章