[已解决]多个电子表合并为一个电子表

zjdh · 发表于 2011-11-11 14:06

可以啊

Sub 汇总()
Application.ScreenUpdating = False
Mypath = ThisWorkbook.Path
Myfile = Dir(Mypath & "\*.xls")
For Each sh In Sheets
NM = NM & "|" & sh.Name
Next
Do Until Myfile = ""
If Myfile <> ThisWorkbook.Name Then
N = Left(Myfile, Len(Myfile) - 4)
If InStr(NM, N) Then GoTo 10
ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count)).Name = N
Set WK = Workbooks.Open(Mypath & "" & Myfile)
WK.Sheets(1).Range("A1:I" & WK.Sheets(1).Range("A65536").End(3).Row).Copy ThisWorkbook.Sheets(N).Range("A1")
WK.Close False
End If
10 Myfile = Dir
Loop
Range("A2:J" & Range("A65536").End(3).Row + 1).ClearContents
For Each sh In Sheets
If sh.Name <> "汇总" Then
sh.Range("A2:I" & sh.Range("A65536").End(3).Row).Copy Range("A65536").End(3)(2)
For I = Range("J65536").End(3).Row To Range("A65536").End(3).Row
If Range("J" & I) = "" Then Range("J" & I) = sh.Name
Next
End If
Next
Sheets("汇总").Select
Application.ScreenUpdating = True
End Sub

复制代码

nonfish · 发表于 2011-11-12 00:29

学习

992582798 · 发表于 2011-11-12 20:49

为什么下载不了呢

笑闹江湖 · 发表于 2011-11-14 01:43

胡说八道吧

笑闹江湖 · 发表于 2011-11-14 01:44

鸡巴论坛我都找不到发帖的地方

杨帆远航 · 发表于 2012-4-3 07:01

一定要学会VBA,谢谢zjdh老师的热情帮助

yychshq · 发表于 2013-8-2 08:46

这个表真好用，十分感谢

guogongyi · 发表于 2013-8-5 20:35

很好，学习了

zhxr311 · 发表于 2014-2-24 22:09

如果工作簿更多，每个表的栏数更多，如何修改？

zhxr311 · 发表于 2014-2-24 23:50

已搞定,第一列不能为空.

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