|
Sub 按钮1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Set sh = ActiveSheet
sh.UsedRange.Offset(1).ClearContents
For Each f In CreateObject("scripting.filesystemobject").getfolder(ThisWorkbook.Path).Files
If InStr(f.Name, "汇总表") = 0 Then
With Workbooks.Open(f)
For Each sht In .Sheets
If sht.Visible = True Then
r = sht.Cells(Rows.Count, 1).End(3).Row
arr = Application.Intersect(sht.Rows("3:" & r), sht.UsedRange)
r = sh.Cells(Rows.Count, 1).End(3).Offset(1).Row
sh.Cells(r, 1).Resize(UBound(arr) - 1, UBound(arr, 2)) = arr
sh.Cells(r, "u").Resize(UBound(arr) - 1).Value = Split(f.Name, ".")(0)
sh.Cells(r, "v").Resize(UBound(arr) - 1).Value = Left(sht.Name, 1)
End If
Next sht
.Close False
End With
End If
Next f
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|
|