合并当前目录下所有工作簿的全部工作表宏代码
2013-01-17 11:23
225 查看
创建一个空的XLS
Ctrl+F11
代码如下:
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本文出自 “精品IT家园” 博客,请务必保留此出处http://syskey.blog.51cto.com/6440170/1120461
Ctrl+F11
代码如下:
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本文出自 “精品IT家园” 博客,请务必保留此出处http://syskey.blog.51cto.com/6440170/1120461
相关文章推荐
- 合并当前目录下所有工作簿的全部工作表
- 合并当前工作簿下的所有工作表
- C++ 删除、重命名文件 、获取当前目录所有文件代码
- VBA 合并当前目录下的工作表
- 将当前目录下所有.bz2的文件解压并合并成一个文件的Shell script
- 合并当前工作簿下的所有工作表
- 关于将不同工作簿中格式相同工作表合并到另一工作簿中的代码再讨论
- 对当前目录下所有文件进行压缩代码
- 【代码】当前目录以及当前目录的所有子目录下查找文件名包含指定字符串的文件,并打印出绝对路径
- 当前目录下所有代码中查找
- 列出zip文件内全部内容 当前目录下的所有文件压缩成zip格式的文件(file.zip)
- 【集中工作薄】 当前文件夹中所有Excel文件中 多个工作簿的第一个工作表 复制到工作簿中
- 转换小写: 将当前目录下的所有文件名全部转换为小写
- VBS获取当前目录下所有文件夹名字的代码
- 将目录下面所有的 .cs 文件合并到一个 code.cs 文件中,写著作权复制代码时的必备良药
- PHP使用递归方式列出当前目录下所有文件的方法
- VB.NET拷贝整个目录下所有子目录及文件的实例代码
- 在windows service的代码中得到当前的目录
- 获取当前目录下所有文件名(扩展名为qar)
- Node.js获取当前代码/启动目录