工作表合并的问题

老米格 · 发表于 2020-1-19 17:00

用VBA合并工作表已经有好多代码了。
然而由于合并之前的表格字段都一样，不方便校对和修订。
能否用代码实现合并之前在每个工作表最左边A列前插入一列，该列里填入该工作表的name。
比如工作表名称分别为1月、2月、3月、4月……，执行代码后每个工作表前插入一列，分别填充成1月、2月、3月、4月……，最后再合并
我能想出大概的步骤和循环结构，但是VBA不熟，不知道该用什么语句、函数
劳烦哪位大神帮忙

罗达 · 发表于 2020-1-19 18:31

Sub 合并目录所有工作簿全部工作表()
Dim MP, MN, AW, Wbn, wn
Dim Wb As Workbook
Dim i, a, b, d, c, e
Application.ScreenUpdating = False
MP = ActiveWorkbook.Path
MN = Dir(MP & "" & "*.xls*")
AW = ActiveWorkbook.Name
Num = 0
e = 1
Do While MN <> ""
If MN <> AW Then
Set Wb = Workbooks.Open(MP & "" & MN)
a = a + 1
With Workbooks(1).ActiveSheet
For i = 1 To Sheets.Count
If Sheets(i).Range("a1") <> "" Then
Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1)
d = Wb.Sheets(i).UsedRange.Columns.Count
c = Wb.Sheets(i).UsedRange.Rows.Count - 1
wn = Wb.Sheets(i).Name
.Cells(1, d + 1) = "表名"
.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn
e = e + c
Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)
End If
Next
Wbn = Wbn & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MN = Dir
Loop
Range("a1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & a & "个工作薄下全部工作表。如下：" & Chr(13) & Wbn, vbInformation, "提示"
End Sub

复制代码

百度来的，经试验很好用。应该刚好符合你的要求

老米格 · 发表于 2020-1-19 19:30

本帖最后由老米格于 2020-1-19 19:32 编辑

这个是若干文件合并，我指的是同一个文件里若干个工作表的合并
合并的代码很多，也一直有用的

我的求助关键是插入一列，填充当前工作表名称，然后所有工作表都如此操作

liulang0808 · 发表于 2020-1-19 19:35

老米格发表于 2020-1-19 19:30
这个是若干文件合并，我指的是同一个文件里若干个工作表的合并
合并的代码很多，也一直有用的

这样的论坛也应该有很多的，楼主先查找看看
不然就上传个模拟附件便于解答

老米格 · 发表于 2020-1-19 19:37

liulang0808 发表于 2020-1-19 19:35
这样的论坛也应该有很多的，楼主先查找看看
不然就上传个模拟附件便于解答

好的，我找找看

罗达 · 发表于 2020-1-19 20:50

老米格发表于 2020-1-19 19:37
好的，我找找看

请上传附件，有空练练手

老米格 · 发表于 2020-1-23 12:08

上传一个模拟文件，请大家看看，通用格式就这样
每次都要合并后做数据透视表汇总，但是因为没有单月的字段，所以月份无法汇总，手动添加字段工作量稍微有点大，每个月几千条。不同身份的职工表格也不一样。

		自动登录	找回密码
密码			免费注册

[求助] 工作表合并的问题