把excel分割成多个文件

admin

1.启用宏
文件-选项-自定义功能区  勾选开发工具
2.点击开发工具-宏
然后随便输入个宏名 点新建
就会看到输入代码的窗口
输入如下代码

1. Sub 分割()
   
2.     Dim i, j, k, m, r As Integer
   
3.     Dim n, total_data As Long
   
4.     Dim path As String
   
5.     Dim title_area, data_column, data_areas As Range
   
6.    
   
7.     Set title_area = Application.InputBox(prompt:="请用鼠标选择表头及表标题所在区域", Title:="选择", Type:=8) '选取表头区域
   
8.     Set data_column = Application.InputBox(prompt:="请鼠标选择需要拆分数据的开始行区域", Title:="选择", Type:=8) '选取拆分起始处
   
9.     m = data_column.Row      '获取分割开始行所在区域行号
   
10.     r = data_column.Column   '获取分割开始行所在区域列号
    
11.     j = data_column.Columns.Count   '获取分割开始行区域列数
    
12.     i = Application.InputBox(prompt:="请输入每次分割数据条目数", Title:="选择")
    
13.   
    
14.    '获取需要分割的数据总条数。这里，可以用两种办法获取到数据区域的尾部行号
    
15.       '第一种，使用传统的：End(xlDown).Row，优点是速度快，缺点是有空白行时会出错
    
16.       '第二种，使用查找方式find，优点是基本不会出错，缺点是条数较多时候可能会慢一点
    
17.    'total_data = Cells(data_column(1, 1)).End(xlDown).Row - m + 1
    
18.     total_data = Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row - m + 1
    
19.     If MsgBox("本次分割文件数据总数为:" & total_data & "条，将会被分割成" & WorksheetFunction.RoundUp(total_data / i, 0) & "个文件，" _
    
20.                 & "点击“确定”开始分割，点击“取消”返回", vbOKCancel, "确认") = vbOK Then
    
21.         Filename = Application.InputBox(prompt:="请输入分割后的文件主名，默认为“分割文件”", Title:="选择", Default:="分割文件")
    
22.         With Application.FileDialog(msoFileDialogFolderPicker)  '获取分割后的文件存储路径
    
23.             If .Show = False Then Exit Sub
    
24.                 path = .SelectedItems(1) & "" '加入"",否则，文件会被存储到选定路径的上一层
    
25.         End With
    
26.         Application.ScreenUpdating = False
    
27.         k = 0   '第几次分割输出，用于标识分割文件次数
    
28.         For n = m To total_data Step i   '从开始分割的行往下计数
    
29.             Set data_areas = Range(Cells(n, r), Cells(n + i - 1, j))   '设置每次循环体内的分割数据主体
    
30.             Application.Union(title_area, data_areas).Select           '把表头区域以及本次循环体内的数据区域进行合并
    
31.             Selection.Copy
    
32.             Workbooks.Add
    
33.             Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    
34.             , SkipBlanks:=False, Transpose:=False      '特殊粘贴：包含源格式的粘贴，以便保持所有格式一致
    
35.            k = k + 1
    
36.            ActiveWorkbook.SaveAs Filename:=path & Filename & "_" & k & ".xlsx", FileFormat:= _
    
37.             xlOpenXMLWorkbook, CreateBackup:=False      '按照既有的文件名、路径、循环次数合并起来存储文件
    
38.             ActiveWindow.Close
    
39.         Next n
    
40.         MsgBox "文件分割完毕！", vbDefaultButton1, "提示"
    
41.     End If
    
42.     Application.ScreenUpdating = True
    
43. End Sub

复制代码

默认情况下xlsx格式的excel文件是不能保存宏的,如果需要保存就把文件另存为xlsm格式的文件就行了
不保存就需要每次使用这个功能的时候都重新复制粘贴代码

然后再次点击宏 就可以运行了
运行以后需要先选择标题栏
再选择起始位置
最后输入分割的行数
就可以了

这个有个缺点是每个文件都有第一行是标题 楼下写不需要标题的

不知道为什么这些代码在网页里面复制 然后粘贴到excel文件里面会有很多问号  直接贴原贴地体吧
https://zhuanlan.zhihu.com/p/81580481?from_voters_page=true

admin

1. Sub 分割()
   
2.     Dim i, j, k, m, r As Integer
   
3.     Dim n, total_data As Long
   
4.     Dim path As String
   
5.    
   
6.     Set data_column = Application.InputBox(prompt:="请鼠标选择需要拆分数据的开始行区域", Title:="选择", Type:=8) '选取拆分起始处
   
7.     m = data_column.Row      '获取分割开始行所在区域行号
   
8.     r = data_column.Column   '获取分割开始行所在区域列号
   
9.     j = data_column.Columns.Count   '获取分割开始行区域列数
   
10.     i = Application.InputBox(prompt:="请输入每次分割数据条目数", Title:="选择")
    
11.   
    
12.    '获取需要分割的数据总条数。这里，可以用两种办法获取到数据区域的尾部行号
    
13.       '第一种，使用传统的：End(xlDown).Row，优点是速度快，缺点是有空白行时会出错
    
14.       '第二种，使用查找方式find，优点是基本不会出错，缺点是条数较多时候可能会慢一点
    
15.    'total_data = Cells(data_column(1, 1)).End(xlDown).Row - m + 1
    
16.     total_data = Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row - m + 1
    
17.     If MsgBox("本次分割文件数据总数为:" & total_data & "条，将会被分割成" & WorksheetFunction.RoundUp(total_data / i, 0) & "个文件，" _
    
18.                 & "点击“确定”开始分割，点击“取消”返回", vbOKCancel, "确认") = vbOK Then
    
19.         Filename = Application.InputBox(prompt:="请输入分割后的文件主名，默认为“分割文件”", Title:="选择", Default:="分割文件")
    
20.         With Application.FileDialog(msoFileDialogFolderPicker)  '获取分割后的文件存储路径
    
21.             If .Show = False Then Exit Sub
    
22.                 path = .SelectedItems(1) & "" '加入"",否则，文件会被存储到选定路径的上一层
    
23.         End With
    
24.         Application.ScreenUpdating = False
    
25.         k = 0   '第几次分割输出，用于标识分割文件次数
    
26.         For n = m To total_data Step i   '从开始分割的行往下计数
    
27.             Set data_areas = Range(Cells(n, r), Cells(n + i - 1, j))   '设置每次循环体内的分割数据主体
    
28.             data_areas.Select           '把表头区域以及本次循环体内的数据区域进行合并
    
29.             Selection.Copy
    
30.             Workbooks.Add
    
31.             Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    
32.             , SkipBlanks:=False, Transpose:=False      '特殊粘贴：包含源格式的粘贴，以便保持所有格式一致
    
33.            k = k + 1
    
34.            ActiveWorkbook.SaveAs Filename:=path & Filename & "_" & k & ".xlsx", FileFormat:= _
    
35.             xlOpenXMLWorkbook, CreateBackup:=False      '按照既有的文件名、路径、循环次数合并起来存储文件
    
36.             ActiveWindow.Close
    
37.         Next n
    
38.         MsgBox "文件分割完毕！", vbDefaultButton1, "提示"
    
39.     End If
    
40.     Application.ScreenUpdating = True
    
41. End Sub
    

复制代码

这个是不需要标题的模式

直接看附件吧