[已解决]文件夹中所有的sh集中到一个表

billyzhang0609

目标文件夹 c:\test\

但是碰到test里面含有多个sheet的表格就吃鳖了。如何修改？

附件如下：

最佳答案

月排行榜 / 总排行榜

yorkchenshunan

2015-9-15 14:40

Sub workload()

  p = "C:\test\" '指定路径
  f = Dir(p & "*.*") '指定档案类型
  Do While f <> ""
   
    Workbooks.Open p & f
   
    For Each sh In Worksheets
        Workbooks(2).Activate  '要先激活新打开的文件，因为第一次循环将SH1拷贝到报表分析工具工作簿后，当前工作簿由新打开的文件转移到了报表分析工具，因此无法进行sh.select
        sh.Select    ‘如果文件含有多个sh，这里就过不去了
        sh.Copy After:=Workbooks("报表分析工具.xlsm").Sheets("程序")

    Next
   
    Workbooks(2).Close False '存档关闭

    f = Dir
  Loop

End Sub

跳转到最佳答案楼层

billyzhang0609

附件发不出来，附上源代码吧：

Sub workload()

  p = "C:\test\" '指定路径
  f = Dir(p & "*.*") '指定档案类型
  Do While f <> ""
   
    Workbooks.Open p & f
   
    For Each sh In Worksheets
      
        sh.Select    ‘如果文件含有多个sh，这里就过不去了
        sh.Copy After:=Workbooks("报表分析工具.xlsm").Sheets("程序")

    Next
   
    Workbooks(2).Close False '存档关闭

    f = Dir
  Loop

End Sub

extyg

set xlwk=Workbooks.Open( p & f)
   
    For Each sh In xlwk.Worksheets
......
xlwk.Close False '存档关闭

yorkchenshunan

Sub workload()

  p = "C:\test\" '指定路径
  f = Dir(p & "*.*") '指定档案类型
  Do While f <> ""
   
    Workbooks.Open p & f
   
    For Each sh In Worksheets
        Workbooks(2).Activate  '要先激活新打开的文件，因为第一次循环将SH1拷贝到报表分析工具工作簿后，当前工作簿由新打开的文件转移到了报表分析工具，因此无法进行sh.select
        sh.Select    ‘如果文件含有多个sh，这里就过不去了
        sh.Copy After:=Workbooks("报表分析工具.xlsm").Sheets("程序")

    Next
   
    Workbooks(2).Close False '存档关闭

    f = Dir
  Loop

End Sub