|
楼主 |
发表于 2011-4-19 09:22
|
显示全部楼层
回复 zhongzuo 的帖子
在其他论坛得到了方法。分享给各位,并感谢作者。
Sub Macro1()
Dim arr, brr(), rng As Range, sh As Worksheet, i&, m&
Set sh = ActiveSheet
arr = Range("A1").CurrentRegion
ReDim brr(1 To UBound(arr))
Set rng = [a1:e1]
m = 1
brr(m) = 1
For i = 3 To UBound(arr)
If InStr(arr(i, 3), "汇总") Then
m = m + 1
brr(m) = i
End If
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To m - 1
With Workbooks.Add(xlWBATWorksheet)
rng.Copy .ActiveSheet.[a1]
sh.Cells(brr(i) + 1, 1).Resize(brr(i + 1) - brr(i), 5).Copy .ActiveSheet.[a2]
.SaveAs Filename:=ThisWorkbook.Path & "\" & Split(arr(brr(i + 1), 3), " 汇总")(0) & ".xls"
.Close
End With
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "ok"
End Sub
|
|