|
本帖最后由 lzqlaj 于 2017-8-14 20:43 编辑
Sub hz()
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer, arr(), aa, ls
aa = Application.InputBox(prompt:="请输入分表表头行数(默认:3)", Title:="分表表头行数", Default:="3", Type:=1)
If aa = False Or aa <= 0 Then Exit Sub
ls = Range("IV" & aa).End(xlToLeft).Column
Application.ScreenUpdating = False '冻结屏幕,以防屏幕抖动
myPath = ThisWorkbook.Path & "\" '把文件路径定义给变量 当前文件夹( 原代码【& "\统计表\" 】)
myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件 xls也可换成其他格式*****
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
For i = 1 To AK.Sheets.Count
With AK.Sheets(i)
aRow = .Range("a65536").End(xlUp).Row
arr = .Range(.Cells(aa + 1, 1), .Cells(aRow, ls)).Value
tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row + 1
ThisWorkbook.Sheets(1).Range("a" & tRow).Resize(UBound(arr), UBound(arr, 2)) = arr
End With
Next
Workbooks(myFile).Close False '关闭源工作簿,并不作修改
End If
myFile = Dir '找寻下一个*.xls文件
Loop
Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
MsgBox "汇总完成,请查看!", 64, "提示"
End Sub |
评分
-
1
查看全部评分
-
|