ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 146|回复: 4

[求助] 【求助】遍历文件夹中所有工作薄,提取指定工作表的数据

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-10-22 20:56 | 显示全部楼层 |阅读模式
本帖最后由 suyeer521 于 2019-10-22 21:01 编辑



请各位大侠帮忙!
1、文件夹内有若干工作薄,各工作薄的工作表名及结构一样;
2、将文件夹中所有的 工作薄名称、  “2月”工作表中的姓名和岗位,提取到汇总表中。
感激!


人名单.rar

27.05 KB, 下载次数: 4

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-22 20:59 | 显示全部楼层
本帖最后由 suyeer521 于 2019-10-22 21:02 编辑

各位大侠帮助解答下

TA的精华主题

TA的得分主题

发表于 2019-10-22 21:18 | 显示全部楼层
典型的工作薄汇总。

Sub test() '多工作薄打开模板mp与mf
        Dim mp$, mf$ '定义变量类型
        Application.DisplayAlerts = False '禁止弹出警告
        Application.ScreenUpdating = False '禁止屏幕刷新
        mp = ThisWorkbook.Path & "\" '有此代码工作薄地址
        mf = Dir(mp & "*.xl*") '显示文件全名(可用通配符)
        Set sh2 = ThisWorkbook.Sheets("sheet1")
        sh2.[a3:c60000].ClearContents
        Do
            If mf <> ThisWorkbook.Name Then '如果mf <>有代码工作薄文件名,就……
               Set dk = Workbooks.Open(mp & mf) '打开指定工作薄
                    Set sh1 = dk.Sheets("2月")
                     r = sh1.Range("a" & Rows.Count).End(3).Row
                     r1 = sh2.Range("a" & Rows.Count).End(3).Row + 1
                     sh1.Range("a2:a" & r).Copy: sh2.Cells(r1, 2).PasteSpecial Paste:=xlPasteValues
                     sh1.Range("b2:b" & r).Copy: sh2.Cells(r1, 3).PasteSpecial Paste:=xlPasteValues
                     sh2.Range("a" & r1 & ":a" & r1 + r - 2) = Left(mf, Len(mf) - 4)
               dk.Close True '关闭指定工作薄(保存→True;不保存→False)
        End If
        mf = Dir '显示下一个工作薄文件名
        If mf = "" Then Exit Do '如果工作薄文件名为“空”,则退出Do循环
    Loop While ThisWorkbook.Name <> "" 'mf有代码工作薄文件名不为空,就进行Do循环
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

TA的精华主题

TA的得分主题

发表于 2019-10-22 21:22 | 显示全部楼层
这是附件.........

人名单111111111111.zip

38.1 KB, 下载次数: 18

TA的精华主题

TA的得分主题

发表于 2019-10-23 10:51 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-11-19 08:37 , Processed in 0.065531 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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