提取多个工作表中几个相同标题的列(不同位置)，然后汇总到新的工作簿

丈量则个世界

新人小白已经百度谷歌了一个下午....崩溃中
详细描述下问题
1. 有多个工作簿(也可以为同一个工作簿中的多个工作表)，数据列数量和位置各不相同
2. 从这些工作簿中提取数据列标题同为"AAA" "BBB" "CCC" "DDD"所有行， 并合并到新的工作簿中
3. 新的工作簿只有"AAA" "BBB" "CCC" "DDD"这四列数据即可

初来乍到，不胜感激

chxw68

欢迎新人来到EH！这个问题不难，建议把有关文件打包上传以方便大家帮你！

microyip

http://club.excelhome.net/thread-1310803-1-1.html，请参考学习

丈量则个世界

chxw68 发表于 2017-11-4 15:48
欢迎新人来到EH！这个问题不难，建议把有关文件打包上传以方便大家帮你！

在公司加班，IT设置了不支持上传文件到外网....谢谢关注

丈量则个世界

microyip 发表于 2017-11-4 15:49
http://club.excelhome.net/thread-1310803-1-1.html，请参考学习

这个真的是太好了，谢谢啦，我学习学习

丈量则个世界

然而还是看不懂，学不会，哪位大神给指点下好么？
以下是我跑过的：
多个工作簿按顺序整合所有列(不管标题相同与否)，合并到一个新的工作簿中
可否帮我加上这个条件？

“”从这些工作簿中提取数据列标题同为"AAA" "BBB" "CCC" "DDD"所有行， 并合并到新的工作簿中“”
楼上大神写的条件筛选完合并没有看懂....不好意思

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Users\E1009412\Downloads\New folder")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

lsc900707

丈量则个世界 发表于 2017-11-4 17:27
然而还是看不懂，学不会，哪位大神给指点下好么？
以下是我跑过的：
多个工作簿按顺序整合所有列(不管标 ...

2楼褚老师已经说的很清楚了，要想解决问题，就提供必要的附件。

eyese

正好需要，先学习学习！感谢！

weidypern

感谢大神指导！