Excel如何合并多个工作薄中的多个工作表？

Question

每个工作薄中都有工作表1,工作表2,工作表3，.......，多个这样的工作薄合并为一个工作薄，合并后里面还是有工作表1,工作表2,工作表3，.....。等于把所有工作薄中工作表1合并，工作表2合并，工作表3合并，......
比如有5个工作薄，每个中有3个工作表，每个表中有2条记录。合并为1个工作薄中还是3个工作表，但每个工作表中有10条记录。

Answer 1

以WPS 2019版本为例：

关于WPS表格合并多个工作簿，您可使用WPS参考下述步骤完成操作：

1.打开表格文件，点击【数据-合并表格】

2.选择添加需合并的文档-开始合并；

3.合并完成后，被合并的工作簿将会变为多个「工作表」存在于一个「工作簿」内。

Answer 2

,整夹合一（D盘的d文件夹），多表合一。

Dim ts9 As String
Dim ArrFiles(1 To 10000) '创建一个数组空间,用来存放文件名称
Dim cntFiles% '文件个数
Dim o3 As Long
Public Function maxrow(xex)
axrow44 = Sheets(xex).[a65536].End(xlUp).Row
axrow45 = Sheets(xex).[b65536].End(xlUp).Row
If axrow44 > axrow45 Then
maxrow = axrow44
Else
maxrow = axrow45
End If
End Function
Public Sub 整夹合一() ''''id5'''（D盘的D文件夹）'''''''''''''''''''''''''''''''''''''''''''''''
Dim strPath$ '声明文件路径
Dim x, x2, f2, p3, i&
Dim k2, k3
Dim axx(1 To 1000)
Worksheets(1).Activate ''''新增一张表
Sheets.Add
Set fso = CreateObject("Scripting.FileSystemObject") ''''返回文件夹中的对象(文件包或子文件夹包)
strPath = "d:\d\" ''''D盘的D文件夹
cntFiles = 0
Set fd = fso.GetFolder(strPath) '设置fd文件夹对象
SearchFiles fd '调用子程序查搜索文件
ThisWorkbook.Sheets(1).Cells().Clear
Sheets(1).Range("a1").Resize(cntFiles) = Application.Transpose(ArrFiles) '把数组内的路径和文件名放在单元格中
k1 = cntFiles
p3 = 1
For x = 1 To k1 Step 1
If Right(ArrFiles(x), 3) = "xls" Or Left(Right(ArrFiles(x), 4), 3) = "xls" Then '''''只对电子表格类型进行移位合并
axx(p3) = x '所在的索引号
Set wk = Workbooks.Open(ArrFiles(x))
wk.Sheets().Move after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
p3 = p3 + 1
End If
Next x
End Sub
Sub SearchFiles(ByV) ''''id6+被调用的子程序。配合上一过程工作，才能完成同夹合一功能
Dim fl
Dim sfd
Set fso = CreateObject("Scripting.FileSystemObject") ''''返回文件夹中的对象(文件包或子文件夹包)
strPath = ByV
Set fd = fso.GetFolder(strPath) '设置fd文件夹对象
For Each fl In fd.Files '通过循环把文件逐个放在数组内,意思是循环文件包中的每一个对象
cntFiles = cntFiles + 1
ArrFiles(cntFiles) = fl.Path
Next fl
If fd.SubFolders.Count = 0 Then
Exit Sub
End If
For Each sfd In fd.SubFolders '''意思是循环文件夹包中的每一个对象
SearchFiles sfd
Next sfd
End Sub
Sub 多表合一() ''''id7
Dim m, n, o, i As Long '任务说明：采用复制粘贴的办法合并一个excel文件中的所有表为一张表，以便整理为数据库格式。
Dim a(1 To 100) As Long
Dim b(1 To 100) As Long
Dim s1, s2, f1, f2 As Long
Worksheets(1).Activate ''''
Sheets.Add
s2 = 1
i = Worksheets.Count 'i=表的张数
Sheets(1).Select '仅取A列为参考，最容易出错。取10列中最大值
o = maxrow(1)
If o > 1 Or o = 1 Then
For s1 = s2 To o '编码
Cells(s1, 254) = "源自本工作簿第00001张表"
Next
End If
For m = 2 To i
Sheets(1).Activate '''''仅取A列为参考，最容易出错。取10列中最大值
o = maxrow(1)

If Sheets(m).Name Like "*源码*" Then ''''源表不进行合并
Else

Sheets(m).Activate ''''
n = maxrow(m)
Sheets(m).Activate ''''
Rows(1 & ":" & n).Select
Range("A" & n).Activate
Application.CutCopyMode = False
Selection.Copy

Sheets(1).Select
o = maxrow(1)
Rows(o + 2 & ":" & o + 2 + n - 1).Select
ActiveSheet.Paste
Range("A" & o + n + 1).Select
Application.CutCopyMode = False
s2 = o + 1

For s1 = s2 To o + n + 5 '编码，主要用于跟踪数据来源
Cells(s1, 254) = "源自本工作簿第0000" & m & "张表"
Next s1
End If
Next m
End Sub

追问

这个不是我要的呀。工作薄里面工作表个数不变，分别合并

Answer 3

没有描述清楚，如果有偿，20可以

Answer 4

80RMB 给你写个