[已解决]求助各位老师 关于遍历

小窗学易

各位老师好
有一个问题需要大家的帮助了
详细看附件
例子文件夹里面有一个原始数据文件夹 里面有不同名字的工作薄（数量不定，需要遍历到）
想做的是把每个工作薄当中xb1工作表（每个工作薄都有）中D7至P7的数据复制到名字叫成果的工作薄中
要求是从B列开始，A列则放xb1中c7中的内容，也就是站名 比如第一个就是艾家堡子
如此原始数据文件中每个工作薄复制到成果工作薄中占一行，然后一行行的往下排。
就如现在成果表里面的样子（我只复制了两个艾家堡了和本溪）
不知道各位老师看懂没 多谢大家了

最佳答案

月排行榜 / 总排行榜

dsmch

2014-12-10 14:56

……………………

跳转到最佳答案楼层

dsmch

……………………

dsmch

………………

小窗学易

dsmch 发表于 2014-12-10 14:58
………………

多谢老师  实现了
太感谢您了
再多问您几句
方便以后做其他应用
1 怎么改变文件夹 只需要把原始数据改成要用到的文件夹名字就可以么
2 怎么改变原始数据的引用，比如说要引用的不是 艾家堡子工作薄里面的xb1工作表 而是本溪工作薄里面的sheet1工作表 需要怎么改
3 如果引用的不是连续的数据 不是c7至p7 而是跳跃的 比如 c7 e7 g7 这样的 需要怎么改变呢
再谢老师

dsmch

…………

小窗学易

dsmch 发表于 2014-12-10 16:12
1、不是的，原始数据文件夹和代码工作簿在同一路径下（把要汇总的工作簿一股脑放入原始数据文件夹下）
2、 ...

Sub Macro1()
Dim mypath$, wj$, wb As Workbook, s%
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path & "\原始数据\"
wj = Dir(mypath & "*.xls*")
Do While wj <> ""
    With GetObject(mypath & wj)
        arr = .Sheets("Xb2").[d7,g7,j7,m7,p7,s7]
        s = s + 1
        Cells(s, 1).Resize(1, UBound(arr, 2)) = arr
        .Close 0
    End With
    wj = Dir
Loop
Application.ScreenUpdating = True
End Sub
老师这是我改的。动了两处，xb1 改为xb2 ，中括号内改为[d7,g7,j7,m7,p7,s7]，目的是引用xb2工作表内的d7,g7,j7,m7,p7,s7六个单元格，但是执行了却没行，感觉还是单元格引用的不对，不是用逗号隔开的么。

小窗学易

dsmch 发表于 2014-12-10 16:12
1、不是的，原始数据文件夹和代码工作簿在同一路径下（把要汇总的工作簿一股脑放入原始数据文件夹下）
2、 ...

那还可以其他方面实现么

dsmch

………………

小窗学易

dsmch 发表于 2014-12-10 17:11

谢谢老师
我给补全了

如下  
Sub Macro1()
Application.ScreenUpdating = False
mypath = ThisWorkbook.Path & "\原始数据\"
wj = Dir(mypath & "*.xls*")
Do While wj <> ""
With GetObject(mypath & wj)
s = s + 1
Cells(s, 1) = .Sheets("Xb1").[d7]
Cells(s, 2) = .Sheets("Xb1").[g7]
Cells(s, 3) = .Sheets("Xb1").[j7]
Cells(s, 4) = .Sheets("Xb1").[m7]
Cells(s, 5) = .Sheets("Xb1").[p7]
Cells(s, 6) = .Sheets("Xb1").[s7]
Close 0
End With
wj = Dir
Loop
Application.ScreenUpdating = True
End Sub
运行提示下界越标
是不是没有选择工作表呢，没看到xb2的字样

小窗学易

dsmch 发表于 2014-12-10 17:11
………………

老师不好意思
确实有点絮叨了
只怪自己懂的太少 工作又着急
再麻烦您最后一次吧
剩下的就全自己来
新发了个附近2
计算要求是一样的 只不过这次需要拷贝的是xb2工作表
需要拷贝的数据分别是 d7 g7 j7 m7 p7 s7  
拷贝完成的成果表和之前是一样的
最后再麻烦您一次 实在抱歉  感谢