提取文件夹中所有不同名称工作簿中相同名称工作表的固定位置内容并汇总到一个新的EXCEL工作簿中。

有几千个工作簿,每个工作簿名称都不一样。每个工作簿中含有多个工作表,其中的一个工作表(名称为TEST-RESULT)的第29行的B到M列数据(即B29:M29)是我需要的... 有几千个工作簿,每个工作簿名称都不一样。
每个工作簿中含有多个工作表,其中的一个工作表(名称为TEST-RESULT)的第29行的B到M列数据(即B29:M29)是我需要的。
结果显示为:每一行 = 工作簿的名称(放在第一列) + TEST-RESULT的B29:M29内容
所有结果在一个新的excel中。
需要一个VBA程序实现。哪位能帮忙写一下呢?感激不尽!我刚接触VBA,实在搞不定啊!可是任务多时间紧。拜托了!
展开
 我来答
nizheiwanyi
2015-01-23 · 知道合伙人软件行家
nizheiwanyi
知道合伙人软件行家
采纳数:546 获赞数:5709
数码爱好者

向TA提问 私信TA
展开全部
可采用如下代码。该文件尽量不要放在目标文件夹中。运行时,只运行该workbook,其余关闭。
其中的扩展名(xls还是xlsx需要你确认一下,可更改)
Sub Data_Col()

Dim my_Path As String
Application.FileDialog(msoFileDialogFolderPicker).Show
my_Path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Dim my_Doc As String
my_Doc = Dir(my_Path & "\" & "*.xlsx") '手动更改扩展名
Dim j As Single
j = 1

Do While Len(my_Doc) <> 0

Workbooks.Open (my_Path & "\" & my_Doc)
ThisWorkbook.Worksheets(1).Cells(j,1)=my_doc
Dim i As Single
For i = 2 To 12

ThisWorkbook.Worksheets(1).Cells(j, i) = Workbooks(2).Worksheets("TEST -RESULT").Cells(29, i)
Next

Workbooks(2).Close

my_Doc = Dir
j = j + 1
Loop
End Sub
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式