ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] excel 多个工作簿里指定工作表 提取到新的工作簿里

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-2-29 11:46 | 显示全部楼层 |阅读模式
excel 多个工作簿里指定工作表(周度价格表) 提取到新的工作簿里,不需要汇总

附件.rar

363.04 KB, 下载次数: 163

TA的精华主题

TA的得分主题

发表于 2016-2-29 12:47 | 显示全部楼层
  1. Sub lqxs()
  2.     Dim mypath$, myName$, mn$, wknm$
  3.     Application.ScreenUpdating = False
  4.     Set sht = ActiveSheet
  5.     nm = [b1].Value
  6.     mypath = ThisWorkbook.Path & ""
  7.     myName = Dir(mypath & "*.xlsx")
  8.     Do While myName <> ""
  9.         If InStr(myName, "长春") Then
  10.             wknm = Split(myName, ".")(0)
  11.             With GetObject(mypath & myName)
  12.                 .Sheets(nm).UsedRange.Copy sht.Cells(sht.Cells.Rows.Count, 1).End(3).Offset(1, 0)
  13.                 .Close False
  14.             End With
  15.         End If
  16.         myName = Dir
  17.     Loop
  18.     MsgBox "ok"
  19.     Application.ScreenUpdating = True
  20. End Sub

复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-2-29 12:54 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2016-2-29 12:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
附件代码424错误.zip (431.45 KB, 下载次数: 159)

TA的精华主题

TA的得分主题

发表于 2016-2-29 13:06 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
╰┛80后の波〃 发表于 2016-2-29 12:54
可不可以分开工作表,不要不要在一个里

不同的工作表 附件代码424错误.zip (435.97 KB, 下载次数: 481)

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-2-29 13:35 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-4-24 13:32 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

如何增加一键删除读取的按钮  求写个VB ,

TA的精华主题

TA的得分主题

发表于 2018-8-16 10:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

老师请问一下多薄多表,不同名工作表可以汇总吗。一个工作薄下有4个工作表,只有表1工作名不一样。想要所有工作薄的表1.表2.表3.表4汇总在一个工作薄

TA的精华主题

TA的得分主题

发表于 2019-1-21 15:20 | 显示全部楼层

请问可以提供一个通用的代码嘛?就是随便什么工作薄都可以使用。

TA的精华主题

TA的得分主题

发表于 2019-1-29 16:40 | 显示全部楼层

Sub lqxs()
&#160; &#160; Dim mypath$, myName$, mn$, wknm$
&#160; &#160; Application.ScreenUpdating = False
&#160; &#160; Set sht = ActiveSheet
&#160; &#160; nm = [b1].Value
&#160; &#160; mypath = ThisWorkbook.Path & ""
&#160; &#160; myName = Dir(mypath & "*.xlsx")
&#160; &#160; Do While myName <> ""
&#160; &#160;&#160; &#160;&#160;&#160;If InStr(myName, "长春") Then
&#160; &#160;&#160; &#160;&#160; &#160;&#160; &#160;wknm = Split(myName, ".")(0)
&#160; &#160;&#160; &#160;&#160; &#160;&#160; &#160;With GetObject(mypath & myName)
&#160; &#160;&#160; &#160;&#160; &#160;&#160; &#160;&#160; &#160; .Sheets(nm).UsedRange.Copy sht.Cells(sht.Cells.Rows.Count, 1).End(3).Offset(1, 0)
&#160; &#160;&#160; &#160;&#160; &#160;&#160; &#160;&#160; &#160; .Close False
&#160; &#160;&#160; &#160;&#160; &#160;&#160; &#160;End With
&#160; &#160;&#160; &#160;&#160;&#160;End If
&#160; &#160;&#160; &#160;&#160;&#160;myName = Dir
&#160; &#160; Loop
&#160; &#160; MsgBox "ok"
&#160; &#160; Application.ScreenUpdating = True
End Sub

可否调整提取office2003工作簿吗?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 20:52 , Processed in 0.055128 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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