所有sheet合并成一页_1分钟拆解：「如何将10多个工作表sheet，合并成一张？」...

最新推荐文章于 2024-06-26 02:47:34 发布

申敏妍SophiaSwan

最新推荐文章于 2024-06-26 02:47:34 发布

阅读量2.6k

点赞数

文章标签：所有sheet合并成一页

本文链接：https://blog.csdn.net/weixin_27146053/article/details/113370093

版权

大家好，我是有讲课堂的认证达人：解题宝宝。

今天到了VBA教学时间！

因为今天阿，解题宝宝无聊闲逛，惊奇发现了两份VBA代码，特意分享给大家。

是解决如何合并大量不同的工作表哒。

多少张都没问题！亲测有效！

分为以下两种情况☟

01 合并同一工作簿的不同工作表。

效果长这样：

本来，同一工作簿下，一个排班表是一张sheet；

接下里，就变成：所有排班表汇总成一张sheet，格式还自动排好！

◎ 效果演示

代码立即备上，宝宝们直接复制粘贴就好，操作无敌容易！

Step 1

新建一个Sheet，鼠标右键选择查看代码。这时你打开了VBA界面。

◎ 操作演示

Step 2

复制以下代码，粘贴进模板编辑框。

Sub 合并当前工作簿下的所有工作表()

Application.ScreenUpdating = False
For j = 1 To Sheets.Count
If Sheets(j).Name <> ActiveSheet.Name Then
X = Range("A65536").End(xlUp).Row + 1
Sheets(j).UsedRange.Copy Cells(X, 1)
End If
Next
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "解题宝宝，我成功啦", vbInformation, "提示"
End Sub

◎ 复制进去后的样子

Step 3

按 F5 调试，见证奇迹发生的时刻叭！

◎ 操作演示

02 并不同工作簿的不同工作表。

首先，你的所有工作簿，要放在同一个储存位置，同一个文件夹，

那下面介绍的操作才会生效哦。

比如解题宝宝的这三个工作簿，都在「考勤记录」文件夹。

这情况下，当我们想打开三份考勤记录，就不得不打开三个文件。

然而，经过解题宝宝的代码，你完全可以实现：三个考勤时间表归总到一个工作簿！

以前总是打开一大堆Excel文件，把电脑卡死？

以后再也不会存在呐！打开一个文件，就能查看所有工作簿。

◎ 效果演示

Step 1

在同一文件夹里，新建一个 XLSL工作表，命名后打开它。

◎ 操作演示

Step 2

点击Sheet1，像刚刚一样打开VBA界面，复制以下代码：

Private Sub hb()
Dim hb As Object, kOne As Boolean, tabcolor As Long
Set hb = Workbooks.Add
Application.DisplayAlerts = False
For i = hb.Sheets.Count To 2 Step -1
hb.Sheets(i).Delete
Next
Dim FileName As String, FilePath As String
Dim iFolder As Object, rwk As Object, Sh As Object
Set iFolder = CreateObject("shell.application").BrowseForFolder(0, "请选择要合并的文件夹", 0, "")
If iFolder Is Nothing Then Exit Sub
FilePath = iFolder.Items.Item.Path
FilePath = IIf(Right(FilePath, 1) = "", FilePath, FilePath & "")
FileName = Dir(FilePath & "*.xls*")
Do Until Len(FileName) = 0
If UCase(FilePath & FileName) <> UCase(ThisWorkbook.Path & "" & ThisWorkbook.Name) Then
Set rwk = Workbooks.Open(FileName:=FilePath & FileName)
tabcolor = Int(Rnd * 56) + 1
With rwk
For Each Sh In .Worksheets
Sh.Copy After:=hb.Sheets(hb.Sheets.Count)
hb.Sheets(hb.Sheets.Count).Name = FileName & "-" & Sh.Name
hb.Sheets(hb.Sheets.Count).Tab.ColorIndex = tabcolor
If Not kOne Then hb.Sheets(1).Delete: kOne = True
Next
.Close True
End With
End If
Set rwk = Nothing
FileName = Dir
Loop
Application.DisplayAlerts = True
End Sub