让同一文件夹中的excel统一执行一个宏

a3348587

我想让同一文件夹下的所有excel 把符合条件的信息复制到sheet2里。我新建一个excel然后执行以下命令。执行之后老是没反应，单个工作簿执行复制宏的时候是没问题。请大神帮忙解决下

Sub aa()

Dim ipath          As String
Dim myfile  As String
Application.ScreenUpdating = False

ipath = "C:\Documents and Settings\Administrator\桌面\VBA测试" & "\"
myfile = Dir(ipath & "*.xlsx")   
If myfile <> "" Then
    Do
        Workbooks.Open ipath & myfile
        Workbooks(myfile).Activate
        Call fuzhi
        Workbooks(myfile).Close True
        myfile = Dir()
    Loop While myfile <> ""
End If

End Sub

---------------------------------以下是复制宏----------------------------------------
Sub fuzhi()
Dim han  
Dim lie   
Dim data '
Dim arr()  
Dim C     

Application.ScreenUpdating = False  


data = Sheets(1).[m65536].End(3).Row
ReDim arr(1 To data, 1 To 17)  
C = 1
For han = 4 To data
If Cells(han, 17) > 0 Then                    
For lie = 1 To 17   
arr(C, lie) = Cells(han, lie)

Next                        
C = C + 1
End If
Next han

Sheets(2).Range("a1").Resize(UBound(arr), 17) = arr
ActiveWorkbook.Save
End Sub


VBA测试.rar (144.67 KB, 下载次数: 31)

2014-5-5 16:05 上传

点击文件名下载附件

a3348587

自己顶以下

LMY123

a3348587 发表于 2014-5-5 15:28
自己顶以下

有时间顶，不如上附件，更有效果

a3348587

LMY123 发表于 2014-5-5 15:52
有时间顶，不如上附件，更有效果

已上传。帮忙看看。。还是我语句错了？

a3348587

求大神帮忙啊

LMY123

a3348587 发表于 2014-5-5 17:32
求大神帮忙啊

试试
Sub Macro1()
    Dim MyPath$, MyName$
    Application.ScreenUpdating = False
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.xlsx")
    Do While MyName <> ""
        With Workbooks.Open(MyPath & MyName)
            .Sheets(1).Select
            Call fuzhi
            .Close True
        End With
        MyName = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

LMY123

a3348587 发表于 2014-5-5 17:32
求大神帮忙啊

VBA测试0505.zip (163.95 KB, 下载次数: 409)

2014-5-5 18:42 上传

点击文件名下载附件

lcjy11185

这个很好，学习了。

a3348587

LMY123 发表于 2014-5-5 18:42

好厉害。谢谢啊

我想请教下。我写的那个语句问题在哪里

4659

mark

谢谢！！@@@