[已解决]求跨工作簿取指定工作表指定单元格数值的代码

wgq985

如：我在B3:B5单元格的数值取“AH0001“工作簿（工作簿地址D:\AH0001.XLS）“1月”工作表的B2:B4数值
          B7:B9单元格的数字取                                                                                      B6:B8的数值
请问这句代码改怎么写？求大侠帮忙，如果我说的不清楚，请看附件

最佳答案

月排行榜 / 总排行榜

过儿

2011-3-4 22:23

下面的程序可以把你所有的文件所有的月份都一并汇总了，只需要这一个就可以了
Sub 汇总()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim arr, mybook As Workbook, mb As Workbook, msh As Worksheet
arr = Range(Cells(1, 2), Range("iv1").End(xlToLeft))
Set mb = ThisWorkbook
For Each msh In Sheets
If Right(msh.Name, 1) = "月" Then
  For y = 1 To UBound(arr, 2)
    Set mybook = GetObject(ThisWorkbook.Path & "/" & arr(1, y) & ".xls")
    msh.Cells(3, y + 1) = mybook.Sheets(msh.Name).Cells(2, 2)
    msh.Cells(4, y + 1) = mybook.Sheets(msh.Name).Cells(3, 2)
    msh.Cells(5, y + 1) = mybook.Sheets(msh.Name).Cells(4, 2)
    msh.Cells(7, y + 1) = mybook.Sheets(msh.Name).Cells(6, 2)
    msh.Cells(8, y + 1) = mybook.Sheets(msh.Name).Cells(7, 2)
    msh.Cells(9, y + 1) = mybook.Sheets(msh.Name).Cells(8, 2)
   Windows(mybook.Name).Visible = True
   mybook.Close True
  Next y
End If
Next msh
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

跳转到最佳答案楼层

wgq985

附件呈上，请查阅

过儿

你这个直接用=引用过来不就行了？

wgq985

因为目标工作簿有100多个，我一个一个引用就很麻烦，而且发给别人的时候还得粘贴数值

过儿

回复 wgq985 的帖子

就是一列一列的那个名子吗？你可以用公式一次性设置啊，这么多文件用VBA处理也挺慢的，因为要一个个的打开

wgq985

是的，很多门店，因为目标工作簿经常改动，如果用公式，发给别人的时候就必须还要粘贴数值，这样目标工作簿变动的时候，我又得引用公式

过儿

第一行的工作簿名称是预设置的，还是根据文件夹的名子自动产生的

wgq985

也不一定，因为我不太会写VBA，请帮我写：B3:B5单元格的数值取“AH0001“工作簿（工作簿地址D:\AH0001.XLS）“1月”工作表的B2:B4数值，B7:B9取B7:B9单元格的数值。其他的我可以参考代码套写，呵呵

醉有缘

占位学习

过儿

下面的程序可以把你所有的文件所有的月份都一并汇总了，只需要这一个就可以了
Sub 汇总()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim arr, mybook As Workbook, mb As Workbook, msh As Worksheet
arr = Range(Cells(1, 2), Range("iv1").End(xlToLeft))
Set mb = ThisWorkbook
For Each msh In Sheets
If Right(msh.Name, 1) = "月" Then
  For y = 1 To UBound(arr, 2)
    Set mybook = GetObject(ThisWorkbook.Path & "/" & arr(1, y) & ".xls")
    msh.Cells(3, y + 1) = mybook.Sheets(msh.Name).Cells(2, 2)
    msh.Cells(4, y + 1) = mybook.Sheets(msh.Name).Cells(3, 2)
    msh.Cells(5, y + 1) = mybook.Sheets(msh.Name).Cells(4, 2)
    msh.Cells(7, y + 1) = mybook.Sheets(msh.Name).Cells(6, 2)
    msh.Cells(8, y + 1) = mybook.Sheets(msh.Name).Cells(7, 2)
    msh.Cells(9, y + 1) = mybook.Sheets(msh.Name).Cells(8, 2)
   Windows(mybook.Name).Visible = True
   mybook.Close True
  Next y
End If
Next msh
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub