|
楼主 |
发表于 2010-11-23 15:23
|
显示全部楼层
代码如下
Sub 获取发料数据()
Sheets(1).Range("a2:IU65536").ClearContents
Application.Calculation = xlCalculationManual '手动重算
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Long
Application.ScreenUpdating = False '冻结屏幕,以防屏幕抖动
myPath = ThisWorkbook.Path & "\维修发料统计\" '把文件路径定义给变量
myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
For i = 1 To AK.Sheets.Count '遍历工作表
If Application.WorksheetFunction.CountA(AK.Sheets(i).Cells) > 0 Then
aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row - 1 'A列最后可见单元行号-1---即不获取最后合计一行
tRow = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row + 1
ThisWorkbook.Sheets(1).Range("a" & tRow & ":a" & tRow + aRow - 1) = Mid(AK.Name, 9, 2) '总是停止在此代码处,,提示溢出,错误6
AK.Sheets(i).Range("a6:iu" & aRow).Copy ThisWorkbook.Sheets(1).Range("b" & tRow) '取得第6行以后的数据
End If
Next
Workbooks(myFile).Close False '关闭源工作簿,并不作修改
End If
myFile = Dir '找寻下一个*.xls文件
Loop
Application.ScreenUpdating = True '恢复刷新屏幕,此类语句一般成对使用
MsgBox "汇总完成,请查看!", 64, "提示"
Application.Calculation = xlCalculationAutomatic '自动重算
End Sub |
|