作者：绿色风
分类：
时间：2022-08-17
浏览：99
楼主
kevinchengcw |
Q: 如何用vba代码将不同文件夹下的工作簿内指定工作表提取后作为独立工作簿另存到上层目录？
A: 示例代码如下：- Sub test2()
- Dim Str$, Arr, N&, Wb As Workbook, WS As Worksheet
- With CreateObject("wscript.shell") '创建WSH项目,用来生成文件清单
- .Run Environ("comspec") & " /c dir """ & ThisWorkbook.Path & "\*.xls?"" /s/b>""" & ThisWorkbook.Path & "\list.txt""", 0, 1 '调用命令行命令生成清单(隐藏执行并等待执行完成后才继续执行后面代码)
- End With
- With CreateObject("scripting.filesystemobject") '创建FSO项目用于读取清单文本
- Str = .opentextfile(ThisWorkbook.Path & "\list.txt").readall
- End With
- Arr = Split(Str, vbNewLine) '将清单文本依换行符拆分放入数组中
- If UBound(Arr) > 0 Then '如果数组中存在有效数据,则
- For N = LBound(Arr) To UBound(Arr) '循环数组各个项
- If Trim(Arr(N)) <> "" And Trim(Arr(N)) <> ThisWorkbook.FullName Then '如果当前项内容有效并且不是本工作簿全路径,则
- Set Wb = GetObject(Arr(N)) '隐藏打开工作簿
- For Each WS In Wb.Worksheets '循环工作簿各个工作表
- If WS.Name = "资产" Or WS.Name = "负债" Then '如果工作表名是要提取的工作表名
- WS.Copy '复制工作表(未指定目的位置时会复制到新工作簿中并激活该工作簿)
- With ActiveWorkbook
- .Worksheets(1).UsedRange = WS.UsedRange.Value '将工作表的内容转换成值
- .SaveAs Left(Wb.Path, InStrRev(Wb.Path, "\")) & Split(Wb.Name, ".")(0) & "-" & WS.Name & ".xls", xlExcel8 '工作簿另存到上层目录中,存为03版格式
- .Close False '关闭工作簿
- End With
- End If
- Next WS '循环到下个工作表
- Wb.Close False '关闭打开的工作簿
- End If
- Next N '循环到数组下一个项目
- End If
- Set Wb = Nothing '清空项目
- Kill ThisWorkbook.Path & "\list.txt" '删除清单文件
- End Sub
附示例文件。
 提取工作表.rar
|
2楼
kszcs |
K版主：
这个我怎么一直没法运行？2003版本的 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一