将多个Excel文件的第一个sheet合并为一个Excel文件中的多个sheet

62 阅读 0 评论 41 点赞

我是靠谱客的博主微笑雪碧，最近开发中收集的这篇文章主要介绍将多个Excel文件的第一个sheet合并为一个Excel文件中的多个sheet，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

本文借鉴整理自博文 https://blog.csdn.net/ZeroBz/article/details/102856403
网上搜到的合并Excel的教程大多都是合并多个文件到一个sheet，本文是将多个Excel文件的第一个sheet合并为一个Excel文件中的多个sheet

将要合并的Excel放在同一个文件夹下面，新建一个Excel文件

在这里插入图片描述
2. 打开新建的Excel，按Alt+F11进入宏计算界面

在这里插入图片描述
点击插入 -> 模块

在这里插入图片描述
3. 将以下代码粘贴进去

'功能：把多个excel工作簿的第一个sh eet工作表合并到一个excel工作簿的多个sheet工作表，新工作表的名称等于原工作簿的名称
Sub Books2Sheets()
'定义对话框变量
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'新建一个工作簿
Dim newwb As Workbook
Set newwb = Workbooks.Add
With fd
If .Show = -1 Then
'定义单个文件变量
Dim vrtSelectedItem As Variant
'定义循环变量
Dim i As Integer
i = 1
'开始文件检索
For Each vrtSelectedItem In .SelectedItems
'打开被合并工作簿
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(vrtSelectedItem)
'复制工作表
tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx 注意！这里是英文的双引号！否则语法编译错误
newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xlsx", "")
'关闭被合并工作簿
tempwb.Close SaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
Set fd = Nothing
End Sub

以上代码是将原Excel的文件名作为合并后的sheet名，但是实际操作中sheet名的限制要远多于Excel文件名（长度、特殊符号等）
下面代码是将合并后的Excel中的多个sheet按照1、2、3依次命名

'功能：把多个excel工作簿的第一个sh eet工作表合并到一个excel工作簿的多个sheet工作表，新工作表的名称等于原工作簿的名称
Sub Books2Sheets()
'定义对话框变量
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'新建一个工作簿
Dim newwb As Workbook
Set newwb = Workbooks.Add
With fd
If .Show = -1 Then
'定义单个文件变量
Dim vrtSelectedItem As Variant
'定义循环变量
Dim i As Integer
i = 1
'开始文件检索
For Each vrtSelectedItem In .SelectedItems
'打开被合并工作簿
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(vrtSelectedItem)
'复制工作表
tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
'下面这一行中将tempwb.Name修改为i
newwb.Worksheets(i).Name = VBA.Replace(i, ".xlsx", "")
'关闭被合并工作簿
tempwb.Close SaveChanges:=False
i = i + 1
Next vrtSelectedItem
End If
End With
Set fd = Nothing
End Sub