|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub 按钮1_Click()
- Application.ScreenUpdating = False
- Set sh = ActiveSheet
- Sheets.Add after:=Sheets(1)
- For J = 1 To sh.Cells(Rows.Count, 1).End(3).Row
- If InStr(sh.Cells(J, 1), "机构名称:") > 0 Then
- Sheets(2).UsedRange.Clear
- sh.Cells(J, 1).CurrentRegion.Copy Sheets(2).[a1]
- Sheets(2).Name = sh.Cells(J, 3)
- Sheets(2).Copy
- With ActiveWorkbook
- .SaveAs ThisWorkbook.Path & "" & sh.Cells(J, 3) & ".xlsx"
- .Close False
- End With
- End If
- Next J
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|