Question

谁能用VBA在EXCEL给我写一段代码把很多格式相同的表合并成一个.不胜感激

标注编号 村名小组名称 组责任人 农户数 村责任人 行政村名 四至范围
266 2 陈芬荣 30 冯世清 虞街村 自留山.水库.自留山.毛竹山
267 1 陈阳尘 26 冯世清 虞街村 花满水库.自留山.自留山.自留山
268 3 祝新法 26 冯世清 虞街村 浦江山.山.自留山.沈宝山
269 7 施宝义 90 冯世清 虞街村 来峰山.浦江山.庄来山.自留山
270 6 陈根谐 24 冯世清 虞街村 山.塘坑.浦江山.浦江山
271 4 冯世清 31 冯世清 虞街村 浦江山.山.自留山.车路
272 5 黄金福 26 冯世清 虞街村 地.小塘.自留山.自留山

这个就是所有EXCEL表的格式.. 愿意奉送全部积分...

Answer 1

新建一个工作表，命名后保存到和与合并的100个文件同一个文件文件夹，摁 alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就OK了。

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

追问

大哥,你这段代码是自己写的吗? VBA的操作我都懂得.只是代码写不好来着..
你这段貌似没按我的格式写诶...

追答

不是自己写的，但这个我经常用，合并到一个表后，再简单的筛选下就全部在一起了
要不你把文件发给我，我试试
email：kxh3515@163.com

追问

哎,你这个不行,这段代码我都能找出很多错误来...
我已经找到解决的方法了.还是用ACCESS来得好啊...只是麻烦了点...
不过总比复制粘贴的好.

Answer 2

是在同一个工作薄中吗???如果是的话,可以追问一下,我来帮你写一个
先发这一段我试验过的,从所有工作表的第二行开始,自动复制到VBA新建的工作表中..
有疑问再问.这个是一个工作薄中指定列的复制
Sub tt()
Application.ScreenUpdating = False
t = Sheets.Count
Sheets.Add after:=Sheets(Sheets.Count)
For i = 1 To t
Sheets(i).Range("A2:L" & Sheets(i).[a65536].End(xlUp).Row).Copy Destination:=Sheets(Sheets.Count).Range("A" & Sheets(Sheets.Count).[a65536].End(xlUp).Row + 1)
Next
Sheets(1).Range("A1:L1").Copy Destination:=Sheets(Sheets.Count).Range("A1")
Application.ScreenUpdating = True
End Sub

Answer 3

其实用VBA也很简单的！
http://zhidao.baidu.com/question/418278503.html?oldq=1
http://zhidao.baidu.com/question/407846563.html?oldq=1