|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub yy()
- Dim i&, Myr&, r%, Arr, Arr1(), ks, js, Brr
- Application.ScreenUpdating = False
- Myr = [a65536].End(xlUp).Row
- Arr = Range("a1:f" & Myr)
- For i = 1 To UBound(Arr)
- If Arr(i, 1) = "标题" Then
- r = r + 1
- ReDim Preserve Arr1(1 To r)
- Arr1(r) = i
- End If
- Next
- For i = r To 2 Step -1
- If i <> r Then
- js = Arr1(i + 1) - 1
- Else
- js = UBound(Arr)
- End If
- ks = Arr1(i)
- nm = "标题" & i
- Cells(ks, 1).Resize(js - ks + 1, 6).Copy
- Workbooks.Add
- Range("a1").Select
- Selection.PasteSpecial Paste:=xlPasteColumnWidths
- Selection.PasteSpecial Paste:=xlPasteFormats
- Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
- ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & nm
- ActiveWorkbook.Close
- Rows(ks).Resize(js - ks + 1).Delete
- Next
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|