Note: The other languages of the website are Google-translated. Back to English

如何在Excel中将多个工作簿合并为一个主工作簿?

当您必须将多个工作簿合并到Excel中的主工作簿时,您是否曾经被困住过? 最可怕的是,您需要组合的工作簿包含多个工作表。 以及如何仅将多个工作簿的指定工作表合并到一个工作簿中? 本教程演示了几种有用的方法来帮助您逐步解决问题。


通过移动或复制功能将多个工作簿合并为一个工作簿

如果只需要合并几个工作簿,则可以使用“移动”或“复制”命令将工作表从原始工作簿手动移动或复制到主工作簿。

1.打开工作簿,您将这些工作簿合并为主工作簿。

2.在原始工作簿中选择要移动或复制到主工作簿的工作表。

笔记:

1)。 您可以选择多个不相邻的工作表,同时按住 按Ctrl 键并一一点击工作表标签。

2)。 要选择多个相邻的工作表,请单击第一个工作表标签,按住 转移 键,然后单击最后一个工作表标签以将其全部选中。

3)。 您可以右键单击任何工作表标签,然后单击 选择所有工作表 从上下文菜单中选择同时在工作簿中的所有工作表。

3.选择所需的工作表后,右键单击“工作表”选项卡,然后单击“确定”。 移动或复制 从上下文菜单中。 看截图:

4.然后 移动或复制 对话框弹出 预订 下拉菜单中,选择要移动或复制工作表的主工作簿。 选择移动以结束 前表 框,选中 建立副本 框,最后单击 OK 按钮。

然后,您可以将两个工作簿中的工作表合并为一个。 请重复上述步骤,将工作表从其他工作簿移至主工作簿。


使用VBA将多个工作簿或指定的工作簿表合并为主工作簿

如果需要将多个工作簿合并为一个,则可以应用以下VBA代码来快速实现它。 请执行以下操作。

1.将要合并的所有工作簿放在同一目录下。

2.启动一个Excel文件(此工作簿将成为主工作簿)。

3。 按 其他 + F11 键打开 适用于应用程序的Microsoft Visual Basic 窗口。 在里面 适用于应用程序的Microsoft Visual Basic 窗口中,单击 插页 > 模块,然后将以下VBA代码复制到“模块”窗口中。

VBA代码1:将多个Excel工作簿合并为一个

Sub GetSheets()
'Updated by Extendoffice 2019/2/20
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xlsx")
  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
	

笔记:

1.上面的VBA代码在合并后将保留原始工作簿的图纸名称。

2.如果要区分主工作簿中的哪些工作表是合并后来自何处,请应用下面的VBA代码2。

3.如果仅要将工作簿的指定工作表合并到主工作簿中,则下面的VBA代码3可以提供帮助。

在VBA代码中,“C:\ Users \ DT168 \ Desktop \ KTE \”是文件夹路径。 在VBA代码3中,Sheet1,Sheet3”是您将合并到主工作簿的工作簿的指定工作表。您可以根据需要进行更改。

VBA代码2:将工作簿合并为一个(每个工作表将以其原始文件名的前缀命名):

Sub MergeWorkbooks()
'Updated by Extendoffice 2019/2/20
Dim xStrPath As String
Dim xStrFName As String
Dim xWS As Worksheet
Dim xMWS As Worksheet
Dim xTWB As Workbook
Dim xStrAWBName As String
On Error Resume Next
xStrPath = "C:\Users\DT168\Desktop\KTE\"
xStrFName = Dir(xStrPath & "*.xlsx")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xTWB = ThisWorkbook
Do While Len(xStrFName) > 0
    Workbooks.Open Filename:=xStrPath & xStrFName, ReadOnly:=True
    xStrAWBName = ActiveWorkbook.Name
    For Each xWS In ActiveWorkbook.Sheets
    xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.Count)
    Set xMWS = xTWB.Sheets(xTWB.Sheets.Count)
    xMWS.Name = xStrAWBName & "(" & xMWS.Name & ")"
    Next xWS
    Workbooks(xStrAWBName).Close
    xStrFName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

VBA代码3:将工作簿的指定工作表合并到主工作簿中:

Sub MergeSheets2()
'Updated by Extendoffice 2019/2/20
Dim xStrPath As String
Dim xStrFName As String
Dim xWS As Worksheet
Dim xMWS As Worksheet
Dim xTWB As Workbook
Dim xStrAWBName As String
Dim xI As Integer
On Error Resume Next

xStrPath = " C:\Users\DT168\Desktop\KTE\"
xStrName = "Sheet1,Sheet3"

xArr = Split(xStrName, ",")

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xTWB = ThisWorkbook
xStrFName = Dir(xStrPath & "*.xlsx")
Do While Len(xStrFName) > 0
Workbooks.Open Filename:=xStrPath & xStrFName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
For xI = 0 To UBound(xArr)
If xWS.Name = xArr(xI) Then
xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.count)
Set xMWS = xTWB.Sheets(xTWB.Sheets.count)
xMWS.Name = xStrAWBName & "(" & xArr(xI) & ")"
Exit For
End If
Next xI
Next xWS
Workbooks(xStrAWBName).Close
xStrFName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

4。 按 F5 键来运行代码。 然后,将某个文件夹中工作簿的所有工作表或指定工作表立即合并到一个主工作簿中。


轻松将多个工作簿或指定的工作簿表合并为一个工作簿

幸运的是 结合 的工作簿实用程序 Kutools for Excel 使将多个工作簿合并为一个更加容易。 让我们看看如何在组合多个工作簿时使该功能发挥作用。

申请前 Kutools for Excel首先下载并安装.

1.创建一个新的工作簿,然后单击 Kutools 加 > 结合。 然后会弹出一个对话框,提醒您所有组合的工作簿都应保存,并且该功能不能应用于受保护的工作簿,请单击 OK 按钮。

2.在 合并工作表 向导,选择 将工作簿中的多个工作表合并到一个工作簿中 选项,然后单击 下一个 按钮。 看截图:

3.在 合并工作表-第2步,共3步 对话框中,单击 地址 > 文件 or 要添加Excel文件,您将合并为一个。 添加Excel文件后,点击 完成 按钮,然后选择一个文件夹来保存主工作簿。 看截图:

现在,所有工作簿都合并为一个。

与以上两种方法相比, Kutools for Excel 具有以下优点:

  • 1)所有工作簿和工作表都在对话框中列出;
  • 2)对于要从合并中排除的工作表,只需取消选中它;
  • 3)空白工作表被自动排除;
  • 4)合并后,原始文件名将作为工作表名称的前缀添加;
  • 有关此功能的更多功能, 请访问这里.

  如果您想免费试用(30-day) 这个实用程序, 请点击下载,然后按照上述步骤进行操作。


Kutools for Excel - 帮助您始终提前完成工作,有更多时间享受生活
您是否经常发现自己正在赶上工作,缺乏时间为自己和家人度过?  Kutools for Excel 可以帮你处理 80% Excel 拼图,提高 80% 的工作效率,让您有更多时间照顾家人,享受生活。
适用于300种工作场景的1500种高级工具使您的工作比以往更加轻松。
从现在起,不再需要记住公式和VBA代码,让您的大脑休息一下。
复杂和重复的操作可以在几秒钟内一次性完成。
每天减少成千上万的键盘和鼠标操作,现在告别职业病。
在3分钟内成为Excel专家,帮助您快速获得认可并提薪。
110,000名高效人才和300多家世界知名公司的选择。
使您的$ 39.0的价值超过$ 4000.0的他人培训。
全功能免费试用 30-天。 60 天无理由退款保证。

按评论排序
注释 (146)
还没有评分。 成为第一位评论!
该评论由网站上的主持人最小化
嗨,请帮助我解决以下情况。 我有不同的工作簿,每个工作簿都有超过 5 个不同路径的工作表。 我需要将不同工作簿中的所有工作表合并到单个工作簿中。 谁能帮我解决macro.TIA!
该评论由网站上的主持人最小化
[quote]嗨,请帮我解决以下问题。 我有不同的工作簿,每个工作簿都有超过 5 个不同路径的工作表。 我需要将不同工作簿中的所有工作表合并到单个工作簿中。 谁能帮我解决macro.TIA!由 A. Karthi[/quote] 请去下载安装 Kutools for Excel,你可以很快搞定。 但是如果要用VBA,可能就太复杂了。 有关如何完成它的更多信息,请访问:http://www.extendoffice.com/product/kutools-for-excel/excel-combine-worksheets-into-one.html
该评论由网站上的主持人最小化
KUTOOLS 很棒的解决方案。 当我创建主工作簿然后工作表的单元格颜色从原始工作表更改时,我需要更多帮助。 我怎样才能保持它像原始工作表一样。
该评论由网站上的主持人最小化
我们的办公室有来自几个 excel 原件的重复数据(即姓名、地址、城市、金额、签名日期),并且尝试合并这些数据将是一项正在进行的工作。 怎样才能消除重复工作和重复信息输入?
该评论由网站上的主持人最小化
我收到一个“运行时错误 1004”,工作表类的复制方法在以下行中失败:Sheet.Copy After:=ThisWorkbook.Sheets(1)。 我正在使用 Excel 2010。你能帮忙吗? 谢谢, - 苏西
该评论由网站上的主持人最小化
嘿,苏西,我自己已经在这个问题上工作了一段时间,得到了同样的错误。 检查该模块是否是在 PERSONAL 而不是您的活动工作簿下创建的。 一旦我在正确的树下创建了模块,下面的代码就可以正常工作了。 Sub GetSheets_xls() Dim Sheet As Worksheet Path = "C:\Users\yournamehere\Desktop\Testingfolder\" Filename = Dir(Path & "*.xls") Do While Filename "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=False Set Sheet = ActiveWorkbook.Sheets(1) Sheet.Copy After:=ThisWorkbook.Sheets(1) 'Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub 希望这有帮助!
该评论由网站上的主持人最小化
非常感谢。 你的代码运行良好。
该评论由网站上的主持人最小化
[quote]我收到“运行时错误 1004”,工作表类的复制方法在以下行中失败:Sheet.Copy After:=ThisWorkbook.Sheets(1)。 我正在使用 Excel 2010。你能帮忙吗? 谢谢, - 苏西通过苏西[/quote] 有同样的问题,当我去查看并取消隐藏“个人”时,它可以工作,在隐藏主控的情况下访问这个宏似乎有问题。
该评论由网站上的主持人最小化
转到查看并取消隐藏“个人”- 在隐藏主控时执行整个代码似乎有问题。 您可以将宏设为该工作簿的本地宏,但每次要使用它时都必须重新创建整个内容
该评论由网站上的主持人最小化
你好! 非常感谢这个文件...... :roll: Best Regard
该评论由网站上的主持人最小化
嘿伟大的提示。 做过 几乎 我想要的。 在组合工作簿中,我希望工作表名称包含原始工作簿的名称,所以我知道数据来自哪个工作簿。 我正在组合的数据来自不同的档案。 我必须搜索一个条目,但不知道它在哪个存档中。因此,通过将所有数据合并到一个文件中,我可以一次搜索所有存档。 但我仍然需要知道,条目在哪个存档中。Henrik
该评论由网站上的主持人最小化
对于包含文件名的代码,只需执行此操作。 Sub GetSheets() Dim temp As String Path = "C:\Users\..\Desktop\Excel combine\" Filename = Dir(Path & "*.xlsx") Do While Filename "" Workbooks.Open Filename:= Path & Filename, ReadOnly:=True temp = ActiveWorkbook.Name ActiveSheet.Name = temp ActiveWorkbook.Sheets(temp).Copy After:=ThisWorkbook.Sheets(1) Workbooks(Filename).Close Filename = Dir() Loop End Sub Note :这是只复制第一张,它可以tweeked做所有的表
该评论由网站上的主持人最小化
如何合并更多工作表以及如何指定不同的主文件来粘贴所有工作表。
该评论由网站上的主持人最小化
这确实是一个很好的解决方案。 谢谢你。 但是有一个问题,当我像这样执行它时,excel会询问我是否要在关闭之前保存更改(因为名称已更改),并且我不想为每个文件都执行此操作(每次执行大约 32 个)。 有没有办法解决这个问题?
该评论由网站上的主持人最小化
这太棒了:lol: 帮了我很多....
该评论由网站上的主持人最小化
谢谢伙计,你从这个非常有用的网站度过了我的一天...实际上我也想将不同工作表的相同标题数据合并到一个主工作表中,用于 Excel 的 KUTOOL 帮助了我很多......再次感谢你.... :)
该评论由网站上的主持人最小化
非常感谢您提供的宝贵信息。 这真的有效。 本文中列出的步骤确实使我的工作变得更轻松。 谢谢, 迪内什
该评论由网站上的主持人最小化
感谢您分享您的知识
该评论由网站上的主持人最小化
您如何获得它来更新原始工作簿中的更改? 我正在尝试获得一份国家摘要,让每个地区将他们的数据输入到他们自己的工作簿中,然后让国家摘要从中更新? 我希望在一开始就将其设置为全年,而不是进行回顾性工作。
该评论由网站上的主持人最小化
将工作表合并到一个工作簿中后,如何保存它我无法保存它被命名为 Book1,我点击保存或另存为但不工作。有什么建议吗?
该评论由网站上的主持人最小化
我按照“使用 VBA 将多个工作簿合并到一个工作簿”中的步骤操作,然后单击“运行”,没有任何反应。 我不知道错误,不知道如何更正。 你能帮我吗? 以下是我在新工作簿中输入的代码。 谢谢 Sub GetSheets() Path = "p:\download\macro\" 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
该评论由网站上的主持人最小化
尊敬的先生/女士: 我按照“使用 VBA 将多个工作簿合并为一个工作簿”的步骤设置了以下模块,但没有任何反应。 你能帮我找出问题吗? 谢谢 Sub GetSheets() Path = "p:\download\macro\" Filename = Dir(Path & "*.xls") Do While Filename "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each ActiveWorkbook.Sheets 中的工作表 Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub
该评论由网站上的主持人最小化
对于较新版本的 excel,试试这个。 我将打开的工作簿保存为目录,所有文件都在 c:\temp 中。 Sub GetSheets() Path = "c:\temp\" Filename = Dir(Path & "*.xls") Do While Filename "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 对于 ActiveWorkbook 中的每个工作表。 Sheets Sheet.Copy After:=Workbooks("catalog.xlsx").Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub
该评论由网站上的主持人最小化
试试这个更新版本的 excel。 我将工作簿保存为目录,所有文件都在 c:\temp 中。 Sub GetSheets() Path = "c:\temp\" Filename = Dir(Path & "*.xls") Do While Filename "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 对于 ActiveWorkbook 中的每个工作表。 Sheets Sheet.Copy After:=Workbooks("catalog.xlsx").Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub
该评论由网站上的主持人最小化
[quote] 尝试更新版本的 excel。 我将工作簿保存为目录,所有文件都在 c:\temp 中。 Sub GetSheets() Path = "c:\temp\" Filename = Dir(Path & "*.xls") Do While Filename "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 对于 ActiveWorkbook 中的每个工作表。 Sheets Sheet.Copy After:=Workbooks("catalog.xlsx").Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub戴夫[/quote] 我不断收到关于路径的“无法分配给只读属性”...有什么想法吗?
该评论由网站上的主持人最小化
我也有这个问题。 你想清楚了吗?
该评论由网站上的主持人最小化
还没有...尚未找到任何解决方案或有人提出修复建议。 对不起...
该评论由网站上的主持人最小化
我也是。 这是 6 个月前的工作,这是我最后一次运行它。 有人找到解决方案了吗? 如果您之前运行过它,现在它无法运行,这可能与 Microsoft 的更新有关吗? 这对我的任务来说非常方便,可以节省大量时间。 有什么改变会导致 Excel 突然开始显示此消息? 作为 VBA 的新手,我不知道从哪里开始分析逻辑。 亲切的问候,格雷格。 格拉斯哥,苏格兰。
该评论由网站上的主持人最小化
似乎“路径”现在已保留,因此请使用任何其他名称并替换“路径”,例如“Mypath”。
该评论由网站上的主持人最小化
也许您应该将 ReadOnly:=True 更改为 ReadOnly:=False,我已经完成了,这很有帮助
该评论由网站上的主持人最小化
我一直在寻找这些方面的东西,但想发表评论。 Do While 文件名“”不需要是“”以外的东西吗? 还是我读错了? 也许 Do While NOT filename = "" 只是一个想法......
该评论由网站上的主持人最小化
我想将所有表格合并到一张标题常见的表格中......请帮助
该评论由网站上的主持人最小化
嗨,我尝试使用上述宏来整理几个文件,不幸的是没有结果...有人可以帮我摆脱手动整理文件的麻烦。
该评论由网站上的主持人最小化
我有 112 张 Excel 表格,我想将其放入一张表格中,无需复制和粘贴。 请帮帮我。
该评论由网站上的主持人最小化
我有一个包含大约 250 Sheet 的工作簿。 我需要一张纸上的柯本。 请给我一个解决方案
该评论由网站上的主持人最小化
试试这个......我从另一个网站得到这个,但不幸的是我不记得这位女士的名字,所以我很抱歉没有提到她,我的错”在 Excel 中合并多个 WB:记住更改 MyPath =!Sub Merge2MultiSheets( ) 将 wbDst 调暗为工作簿 将 wbSrc 调暗为工作簿 将 wsSrc 调暗为工作表 将 MyPath 调暗为字符串 将 strFilename 调暗为字符串 Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False MyPath = "\\MyPath\etc\etc..."设置 wbDst = Workbooks.Add(xlWBATWorksheet) strFilename = Dir(MyPath & "\*.xls", vbNormal) If Len(strFilename) = 0 Then Exit Sub Do until strFilename = "" Set wbSrc = Workbooks.Open(Filename:= MyPath & "\" & strFilename) Set wsSrc = wbSrc.Worksheets(1) wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count) wbSrc.Close False strFilename = Dir() Loop wbDst.Worksheets(1)。删除 Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub
该评论由网站上的主持人最小化
嗨,我将代码添加到模块中。 将 Excel 书命名为 Masterfile。 我在代码中的哪个位置添加。 谢谢你
该评论由网站上的主持人最小化
这些都不适合我,我终于让这个工作了。 仅供参考,我使用的是 2010 '描述:将文件夹中的所有文件合并到一个主文件中。 Sub MergeFiles() 将路径作为字符串,ThisWB 作为字符串,lngFilecounter 只要将 wbDest 作为工作簿,shtDest 作为工作表,ws 作为工作表将文件名作为字符串,Wkb 作为工作簿将 CopyRng 作为范围,Dest 作为范围将 RowofCopySheet 作为整数 RowofCopySheet = 2 ' 从 ThisWB = ActiveWorkbook.Name path = "mypath ....." 复制的工作表中开始的行 ' 不要忘记更改此 Application.EnableEvents = False Application.ScreenUpdating = False 设置 shtDest = ActiveWorkbook .Sheets(1) Filename = Dir(path & "\*.xls", vbNormal) If Len(Filename) = 0 Then Exit Sub Do until Filename = vbNullString If Not Filename = ThisWB Then Set Wkb = Workbooks.Open(Filename: =path & "\" & Filename) Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)) Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1) CopyRng.Copy Dest Wkb.Close False End If Filename = Dir() Loop Rang e("A1").Select Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "完成!" 结束子
该评论由网站上的主持人最小化
如何编辑它以使拉入的数据始终从第一行开始? 如果我运行此代码两次,它会将数据添加到我之前数据的末尾(从宏的第一次运行开始)。
该评论由网站上的主持人最小化
更改此行: RowofCopySheet = 2 为 RowofCopySheet = 1
该评论由网站上的主持人最小化
嗨,我有多个带有密码保护的 Excel 文件(单张)不同的文件夹。 我想在一天结束时将所有数据合并到一个主文件中。 每次我必须输入密码并打开文件并将粘贴复制到主文件时。请帮助我使用 VBA 代码。
这里还没有评论
了解更多

关注我们

版权所有 © 2009 - extendoffice.com。 | 版权所有。 供电 ExtendOffice。 | 网站地图
Microsoft和Office徽标是Microsoft Corporation在美国和/或其他国家的商标或注册商标。
受Sectigo SSL保护