1. 打开需要拆分的 Excel 文件，按下 ALT + F11 组合键，打开 VBA 编辑器。
  2. 在 VBA 编辑器中，右键单击项目导航窗格中的“Microsoft Excel 对象”，选择“插入”-“模块”，创建一个新的模块，名称可任意取。
  3. 将该段代码复制到新建的模块中。
  4. 修改代码中的 WJhangshu 变量值为要拆分的每个工作簿中的最大行数（默认为 15000）。
  5. 按下 F5 键或单击工具栏上的“运行”按钮来执行代码，Excel 会自动按照指定的行数拆分表格，并保存为多个工作簿。
Sub cfb()
    Dim r, c, i, WJhangshu, WJshu, bt As Long
    Dim originalFileName As String, originalFilePath As String, originalExtension As String
    Dim newFileName As String
    
    r = Range("A" & Rows.Count).End(xlUp).Row
    c = Cells(1, Columns.Count).End(xlToLeft).Column
    bt = 1 'title
    WJhangshu = 15000 'num
    WJshu = IIf(r - bt Mod 20000, Int((r - bt) / WJhangshu), Int((r - bt) / WJhangshu) + 1)
    
    originalFileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) '获取原文件名
    originalFilePath = ThisWorkbook.Path '获取原文件路径
    originalExtension = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, ".")) '获取原文件扩展名
    
    For i = 0 To WJshu
        Workbooks.Add
        Application.DisplayAlerts = False
newFileName = originalFileName & "_" & Format(i + 1, String(Len(WJshu), 0))
        ActiveWorkbook.SaveAs Filename:=originalFilePath & "\" & newFileName & "." & originalExtension
        Application.DisplayAlerts = True
        ThisWorkbook.ActiveSheet.Range("A1").Resize(bt, c).Copy ActiveSheet.Range("A1")
        ThisWorkbook.ActiveSheet.Range("A" & bt + i * WJhangshu + 1).Resize(WJhangshu, c).Copy _
            ActiveSheet.Range("A" & bt + 1)
        ActiveWorkbook.Close True
    Next
End Sub
  • Dim r, c, i, WJhangshu, WJshu, bt As Long：声明变量。
  • r = Range("A" & Rows.Count).End(xlUp).Row：获取 A 列中最后一个非空单元格的行数，也就是表格中的最后一行。
  • c = Cells(1, Columns.Count).End(xlToLeft).Column：获取第一行最后一个非空单元格的列数，也就是表格中的最后一列。
  • bt = 1: 设置开始复制数据的行数，这里为第一行。
  • WJhangshu = 15000：设置每个工作簿中最大的行数。
  • WJshu = IIf(r - bt Mod 20000, Int((r - bt) / WJhangshu), Int((r - bt) / WJhangshu) + 1)：计算需要分割成几个工作簿，其中加入了用 Mod 操作保证表格总行数可以被 25000 整除。
  • originalFileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)：获取当前文件的文件名。（新增代码）
  • originalFilePath = ThisWorkbook.Path：获取当前文件的路径。（新增代码）
  • originalExtension = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, "."))：获取当前文件的扩展名。（新增代码）
  • For i = 0 To WJshu：循环创建并保存每个工作簿。
  • Workbooks.Add：新建一个工作簿。
  • Application.DisplayAlerts = False：将显示警告设置为非活动状态，以免在保存工作簿时弹出提示框。
  • newFileName = originalFileName & "_" & Format(i, String(Len(WJshu), 0))：生成新的文件名，命名规则为原文件名加下划线及数字后缀，例如“file_1.xlsx”、“file_2.xlsx”，其中数字后缀的位数与需要分割成的工作簿总数保持一致。（新增代码）
  • ActiveWorkbook.SaveAs Filename:=originalFilePath & "\" & newFileName & "." & originalExtension：将工作簿保存到原文件夹下，并以生成的新文件名命名。
  • Application.DisplayAlerts = True：将显示警告设置为活动状态。
  • ThisWorkbook.ActiveSheet.Range("A1").Resize(bt, c).Copy ActiveSheet.Range("A1")：将原表中的第一行复制到新建的工作簿中。
  • ThisWorkbook.ActiveSheet.Range("A" & bt + i * WJhangshu + 1).Resize(WJhangshu, c).Copy ActiveSheet.Range("A" & bt + 1)：将原表中的数据按预设的行数进行分割，并复制到新建的工作簿中。
  • ActiveWorkbook.Close True：关闭并保存新建的工作簿。