ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2974|回复: 4

[求助] 合并文件夹下多个多sheet表格为一个多sheet表格,新手求助!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-10-17 13:03 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本人想要合并一个文件夹下的多个excel表格,表格的名字无规律,有xlsx和xls两种格式,每个表格有多个sheet,sheet的名字不同,但顺序相同,表头相同。
合并成为一个新的多sheet的表格,每个sheet把数据汇总就可以。
由于本人刚接触VBA,也没有代码基础,暂时将这个需求分为3段:
1.打开文件夹下所有表格
2.创建一个新的汇总表,添加sheet并修改名字,给每个sheet添加表头
3.除VBA所在表格和新建汇总表外,将打开的表格的每个sheet中第二行开始复制到新建汇总表对应的sheet A列最后一个空的单元格
由于接触时间短,逻辑比较混乱,参考书上的一些写法,前两段可以运行,第三段不能运行,麻烦各位大神帮忙看看
或者各位是否写过类似vba可以供我参考,十分感谢!

Sub 打开文件夹下所有xlsx表格()
Application.ScreenUpdating = False
Dim myPath As String, myFile As String, wb As Workbook '打开文件夹下所有xlsx格式的文件
myPath = ThisWorkbook.Path
myFile = Dir(myPath & "\*.xlsx")
    Do While myFile <> "" '
         If myFile <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(myPath & "\" & myFile)
        End If
    myFile = Dir
    Loop
Application.ScreenUpdating = True
End Sub

Sub 新建汇总表格()
Application.DisplayAlerts = False
Dim wb As Workbook, sht As Worksheet, i As Long '新建workbook改名,worksheet改名,加表头
Set wb = Workbooks.Add
i = 1
    For i = 1 To Month(Date) - 2 Step 1
    Set sht = Worksheets(i)
    sht.Name = "订单上报日期" & i + 2 & "月"
    sht.Range("a1:t1") = Array("订单号", "订单上报日期", "ASC代码", "ASC名称", "ASC收货人", "ASC收货人手机号", "ASC收货地址", "零件号", "供应商", "零件名称", "订购数量", "发货数量", "快递单号", "快递公司名称", "发货时间", "预计发货时间", "签收日期", "实际签收人", "实际签收人联系方式", "备注")
    Worksheets.Add after:=Worksheets(i)
    Next
Worksheets(i).Delete '删掉多余的最后一个sheet
wb.SaveAs FileName:=ThisWorkbook.Path & "\DD精品跟踪单-" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & ".xlsx"
Application.DisplayAlerts = True
End Sub

Sub 合并内容()
Dim wb As Workbook, sht As Worksheet, r As Long, c As Long, i As Long, rng As Range, myPath As String, myFile As String
myPath = ThisWorkbook.Path
myFile = Dir(myPath & "*.xlsx")
    Do While myFile <> "" '循环至表格名字为空
        If myFile <> ThisWorkbook.Name And "DD精品跟踪单-" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & ".xlsx" Then '判断表格不是VBA表格和汇总表
            For i = 1 To sheetcount '对于表格内每个sheet进行操作            
            rng = Worksheets(i).Range("a2").CurrentRegion.Select '选择填了信息单元格区域
            r = Rows("rng")
            c = Columns("rng")            
            rng = Range(Cells(2, 1), Cells(r, c)).Select '通过选择A2至最后一个单元格去表头赋值给rng
            Range(rng).Copy Workbooks("DD精品跟踪单-" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & ".xlsx").Worksheets(i).Range("a108597").End(xlUp)
            '复制rng至汇总表A列最后一个空格            
            Next
        End If
    Loop
End Sub

物流信息汇总VBA.rar

369.13 KB, 下载次数: 17

TA的精华主题

TA的得分主题

发表于 2019-10-17 13:26 | 显示全部楼层
欢迎新朋友,在附件更新了,借用了楼主部分代码,结果在程序文件里,供参考

物流信息汇总VBA.zip

673.69 KB, 下载次数: 60

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-17 14:09 | 显示全部楼层
liulang0808 发表于 2019-10-17 13:26
欢迎新朋友,在附件更新了,借用了楼主部分代码,结果在程序文件里,供参考

谢谢!操作可行逻辑简单,我先研究一下里面的代码,十分感谢!

TA的精华主题

TA的得分主题

发表于 2019-10-21 23:18 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-11-6 11:46 | 显示全部楼层
image.png
麻烦大神帮忙看一下是什么原因导致的
附上附件   谢谢

汇总 的副本.zip

34.96 KB, 下载次数: 2

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

本版积分规则

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

GMT+8, 2024-3-29 18:19 , Processed in 0.054616 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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