[已解决]打开一个文件下所有文件并操作

a8598048

我有一个小需求  做一个EXCEL宏 点击之后它可以打开所在文件夹里的所有EXCEL文件,复制第二列内容，依次粘帖到我这个带宏的EXCEL里
我自己写的,没能实现 求帮忙
Sub 按钮1_Click()
Application.ScreenUpdating = False
Dim filename As String
Dim bw As String
Dim mypath As String
mypath = ThisWorkbook.Path
filename = Dir(mypath, vbNormal)
Do While filename <> ""
filenames = Dir
bw = filename
Workbooks.Open filename:=ThisWorkbook.Path & "\" & "bw.XLSm"
Range("C1:C200").Copy
Windows("汇总.xlsM").Activate
i = 1
cell(1, i).Select
ActiveSheet.Paste
Windows("bw.xlsm").Close
i++
Loop
Application.ScreenUpdating = True
End Sub

最佳答案

月排行榜 / 总排行榜

lisachen

2013-6-19 14:55

1. Sub 按钮2_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim filename As String
   
5.     Dim mypath As String
   
6.     mypath = ThisWorkbook.Path & "\*.*xl*"
   
7.     filename = Dir(mypath, vbNormal)
   
8.     Do While filename <> ""
   
9.         If filename = "汇总.xlsm" Then GoTo 100
   
10.         Workbooks.Open filename:=ThisWorkbook.Path & "" & filename
    
11.         Range("C1:C200").Copy
    
12.         Windows("汇总.xlsM").Activate
    
13.         i = i + 1
    
14.         Cells(1, i).Select
    
15.         ActiveSheet.Paste
    
16.         Windows(filename).Close
    
17. 100:
    
18.         filename = Dir
    
19.     Loop
    
20.     Application.DisplayAlerts = True
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

不好意思汇总.xlsM应改成汇总.xlsm

跳转到最佳答案楼层

妞叫七七

和这个很相像,你参考一下吧http://www.excelpx.com/thread-303159-1-1.html

lisachen

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim filename As String
   
5.     Dim mypath As String
   
6.     mypath = ThisWorkbook.Path & "\*.*xl*"
   
7.     filename = Dir(mypath, vbNormal)
   
8.     Do While filename <> ""
   
9.         If filename = "汇总.xlsM" Then GoTo 100
   
10.         Workbooks.Open filename:=ThisWorkbook.Path & "" & filename
    
11.         Range("C1:C200").Copy
    
12.         Windows("汇总.xlsM").Activate
    
13.         i = i + 1
    
14.         Cells(1, i).Select
    
15.         ActiveSheet.Paste
    
16.         Windows(filename).Close
    
17. 100:
    
18.         filename = Dir
    
19.     Loop
    
20.     Application.DisplayAlerts = True
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

a8598048

lisachen 发表于 2013-6-19 13:51

谢谢哥们啊 但是现在运行会生成一个空表
我把这句隐藏了
'Application.DisplayAlerts = False
'Application.DisplayAlerts = True
会提示是否保修剪切板中内容 我点是 才会生效.
有方法处理么？
还有当打开到汇总表时转到100
100里面 fileNAME=DIR也不对吧
应该当FILENAME= 汇总表时 不打开 要怎么改呢？
万分感谢！！！！

a8598048

妞叫七七 发表于 2013-6-19 13:37
和这个很相像,你参考一下吧http://www.excelpx.com/thread-303159-1-1.html

大哥 帮我看看现在怎么办  马上就成功了  看下我的回复

a8598048

lisachen

a8598048 发表于 2013-6-19 14:26
谢谢哥们啊 但是现在运行会生成一个空表
我把这句隐藏了
'Application.DisplayAlerts = False

• 为什么要隐藏呢，'Application.DisplayAlerts = True
  目的就是处理你说的问题
  
  
  这句就是 If filename = "汇总.xlsM" Then GoTo 100应该当FILENAME= 汇总表时 不打开
  

a8598048

lisachen 发表于 2013-6-19 14:42

为什么要隐藏呢，'Application.DisplayAlerts = True
目的就是处理你说的问题

我是不知道问题出在哪才隐藏的 你说的对 用那句就不会提示了
但是现在执行后是空的
因为我看执行的时候有一步提示汇总表已经打卡 是否重新打开  点是就是现在的效果
如果点否就会报错 WINDOWS.CLOSE  
问题应该出在这里   
我这个代码是写在汇总表里的
也就是说先打开汇总表，然后点按钮， 实现我的功能 .
现在运行时会出现 汇总表已经打开了 是否重新打开
请帮帮忙

a8598048

lisachen 发表于 2013-6-19 14:42

为什么要隐藏呢，'Application.DisplayAlerts = True
目的就是处理你说的问题

也就是说现在 当FILENAME=汇总表的时候 程序也打开了
所以我怀疑  100 里的代码 不对

lisachen

1. Sub 按钮2_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim filename As String
   
5.     Dim mypath As String
   
6.     mypath = ThisWorkbook.Path & "\*.*xl*"
   
7.     filename = Dir(mypath, vbNormal)
   
8.     Do While filename <> ""
   
9.         If filename = "汇总.xlsm" Then GoTo 100
   
10.         Workbooks.Open filename:=ThisWorkbook.Path & "" & filename
    
11.         Range("C1:C200").Copy
    
12.         Windows("汇总.xlsM").Activate
    
13.         i = i + 1
    
14.         Cells(1, i).Select
    
15.         ActiveSheet.Paste
    
16.         Windows(filename).Close
    
17. 100:
    
18.         filename = Dir
    
19.     Loop
    
20.     Application.DisplayAlerts = True
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

不好意思汇总.xlsM应改成汇总.xlsm