excel拆分成多个表

第一步：

打开要拆分的Excel

然后按  Alt+F11

调出函数输入模块

双击左侧的薄名

第二步：键入下面内容

 

Sub aa()
Dim newbook As Workbook
a = ThisWorkbook.Name
b = ActiveSheet.Name
h = InputBox("请输入行数")
Application.ScreenUpdating = False
For n = 0 To Range("a65536").End(xlUp).Row \ h
Windows(a).Activate
Sheets(b).Activate
Rows((h * n + 1) & ":" & (h * n + h)).Copy
Set newbook = Workbooks.Add
With newbook
newbook.Activate
ActiveSheet.Paste
.SaveAs Filename:=ThisWorkbook.Path & "\" & Replace(a, ".xls", "") & n & ".xlsx"
.Close
End With
Next n
Application.ScreenUpdating = True
End Sub

 

第三步 ：运行  箭头