鸿 网 互 联 www.68idc.cn

当前位置 : 服务器租用 > 网络程序脚本 > VBA > >

合并多个excel表格的VBA

来源:互联网 作者:佚名 时间:2015-09-27 08:19
编辑器加载中...如果表不算太多的话可以试试这种方法,打开总表(要粘贴的表),打开一个要复制的表,右击要复制的工作表标签,选择移动或复制工作表,建立副本,选择要移动到表(要粘贴的那总表)。这种方法对 合并 到同一个文件中还是可行的。但你说的汇总

编辑器加载中...如果表不算太多的话可以试试这种方法,打开总表(要粘贴的表),打开一个要复制的表,右击要复制的工作表标签,选择移动或复制工作表,建立副本,选择要移动到表(要粘贴的那总表)。这种方法对合并到同一个文件中还是可行的。 但你说的汇总到一张表里就不行了,可以试试用“=”建立链接(要用相对地址),但这种方法对表结构相同或类似的才可以,而且文件名和表名称要有规律。这样会很快汇总到一张表中,下面的活儿就是整理一下的工作了,要是要数据的话就把链接改成数据才可以,这种方法好在可以动态更新你的数据。 写代码也可以,但若是工作量很大的话可考虑! 新建一个工作表,命名后保存到和与合并的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
网友评论
<