Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2962|回复: 3

同一文件夹内excel文件合并并且加一列

[复制链接]
发表于 2017-12-3 17:52 | 显示全部楼层 |阅读模式
本帖最后由 eccrazy 于 2017-12-3 18:08 编辑

我是一个小菜鸟,vba看了半天看不懂。目前能实现合并,但是不能同时做到把文件名称加到表格的最后一列里。我做了个简单的表格,做例子,麻烦大神指导下。
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("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
If ThisWorkbook.Sheets(1).Range("A2") = "" Then                                     '新加的判断
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

Else
Wb.Sheets(G).UsedRange.Offset(3, 0).Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) '.offset(1,0)是新加的,其中3是标题行数
End If
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub

想要合并.zip

26.54 KB, 下载次数: 8

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-12-3 19:02 | 显示全部楼层
有一些改动,我可能都标记了。另外,你编的代码统计各工作薄的各表,我就在你2号的工作薄的第二个工作表加了些数据以供测试。

想要合并2.rar

40.42 KB, 下载次数: 41

回复

使用道具 举报

 楼主| 发表于 2017-12-3 19:07 | 显示全部楼层
高 发表于 2017-12-3 19:02
有一些改动,我可能都标记了。另外,你编的代码统计各工作薄的各表,我就在你2号的工作薄的第二个工作表加 ...

万分感谢
回复

使用道具 举报

发表于 2017-12-21 10:55 | 显示全部楼层
学习了
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 08:46 , Processed in 0.527653 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表