企业官网建设流程全解析

前段时间帮朋友处理一个客户数据表，五万多行。对方系统每次只能导入1000行，而且每个文件都得带表头。

一开始我是手动干的：选中1000行、复制、新建工作簿、粘贴表头、粘贴数据、另存为、起个文件名……拆到第十个的时候人就麻了。五万多行要拆五十多个文件，全靠手点，一下午就交代进去了。

后来写了段VBA，再遇到这种活直接跑一遍，几秒钟的事。代码放这儿，你直接抄去用就行：

Sub SplitExcelByRows() Dim wsSource As Worksheet Dim wbTarget As Workbook Dim lastRow As Long Dim totalDataRows As Long Dim rowsPerFile As Long Dim fileCount As Long Dim i As Long Dim startRow As Long Dim endRow As Long Dim savePath As String Dim baseName As String Dim newFileName As String On Error GoTo ErrorHandler Set wsSource = ThisWorkbook.Worksheets("Sheet1") rowsPerFile = 1000 lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row If lastRow < 2 Then MsgBox "数据不足，无法拆分" Exit Sub End If totalDataRows = lastRow - 1 fileCount = (totalDataRows + rowsPerFile - 1) \ rowsPerFile savePath = ThisWorkbook.Path If savePath = "" Then MsgBox "请先保存当前工作簿再运行此程序" Exit Sub End If baseName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) Application.ScreenUpdating = False Application.DisplayAlerts = False For i = 1 To fileCount DoEvents Set wbTarget = Workbooks.Add(xlWBATWorksheet) '复制表头 wsSource.Rows(1).Copy Destination:=wbTarget.Worksheets(1).Rows(1) startRow = 2 + (i - 1) * rowsPerFile endRow = startRow + rowsPerFile - 1 If endRow > lastRow Then endRow = lastRow wsSource.Range("A" & startRow & ":A" & endRow).EntireRow.Copy _ Destination:=wbTarget.Worksheets(1).Rows(2) newFileName = savePath & "\" & baseName & "_Part" & i & ".xlsx" wbTarget.SaveAs Filename:=newFileName, FileFormat:=xlOpenXMLWorkbook wbTarget.Close SaveChanges:=False Next i Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "拆分完成，共生成 " & fileCount & " 个文件，每个文件包含列名和最多1000行数据" Exit Sub ErrorHandler: Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "发生错误：" & Err.Description End Sub

用法：打开你的文件，Alt+F11打开VBA编辑器，插入模块，把代码贴进去，F5运行。跑完会弹个提示，去原文件所在的文件夹看，拆出来的文件都在那儿，名字是“原文件名_Part1”“原文件名_Part2”这样排下去的。
有两个前提要注意：数据得放在名叫Sheet1的表里，工作簿本身得先保存过（因为代码要取它所在的目录）。

代码里有几处可以聊聊

第一个是算要拆几个文件这行：

fileCount = (totalDataRows + rowsPerFile - 1) \ rowsPerFile

比如2500行数据，每个文件1000行，得拆3个而不是2个，因为最后那500行也得有个文件装。VBA里没有现成的向上取整函数，(a + b - 1) \ b这个写法是最省事的等价方案，不算VBA专属技巧，很多语言里都能这么写，记一下以后用得上。
第二个是找最后一行：

lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row

从A列最底下往上摸，碰到第一个非空单元格停。不管数据是一千行还是一百万行，都能找准边界。我见过不少人写死一个Range("A10000")，数据一超就出错，这个写法就没这个坑。

第三处是取文件名：

baseName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)

这里用的是InStrRev，从后往前找小数点，而不是InStr。区别在于，如果你的文件叫“2024.09报表.xlsx"，InStr找到的是第一个点，截出来就成"2024"了，InStrRev找的是最后一个点，才能正确取出完整文件名。这个坑我踩过，你们别再踩。
最后一处是开头那两行：

Application.ScreenUpdating = False Application.DisplayAlerts = False

关掉屏幕刷新和系统弹窗，拆几十个文件的时候速度快很多，屏幕也不会闪个不停。但重点其实在错误处理那段——出错的时候也把它们改回来。很多人只记得开头关，忘了出错后开，结果程序一崩，Excel就留在那个“不刷新、不弹窗”的傻状态，看着像卡死了。别小看这个细节。

想改的话

每个文件装多少行，改rowsPerFile = 1000这一行，改成500、2000随你。
数据不在Sheet1的话，把Worksheets("Sheet1")里的表名换掉。
输出文件的命名在后半段那句newFileName里，比如想把"_Part"改成“_批次”，改字符串就行。
另外说一句，拆出来的文件存的是xlsx格式，公式会保留算出来的值，但原文件里如果带宏，宏不会被带过去。拆之前最好还是备份一下原表，虽然这代码不动原数据，但备份这个习惯总没坏处。

写这段代码花了不到十分钟，但省下的时间已经数不清了。其实按部门拆、按月份拆，跟按行数拆是一个思路，改改循环里的判断条件的事。有想看的具体场景可以留言，我后面挑几个写写。
觉得有用就转给那个还在手动复制粘贴的同事吧。