Sub 拆分表格()

    Dim i&, iBT$, irow&, iNm$, k%

    iBT = InputBox(请输入标题的行数： & vbLf & vbLf & 如没标题有请填0, 标题行数, 1)

    If iBT = Then Exit Sub

    iNm = ActiveSheet.Name

    irow = Range(A & Rows.Count).End(3).Row

    For i = Val(iBT) + 1 To irow Step 1000

        k = k + 1

        Sheets.Add after:=Sheets(Sheets.Count)

        Sheets(Sheets.Count).Name = 数据表- & k

        If Val(iBT) > 0 Then Sheets(iNm).Rows(1: & iBT).Copy Range(A1)

        Sheets(iNm).Rows(i & : & i + 1000 - 1).Copy Range(A & Val(iBT) + 1)

    Next

    Sheets(iNm).Select

    MsgBox 处理完毕！, , 提示

End Sub

Excel自带有VBA的，建议用VBA来处理这样的数据。可以用一个for循环，步长值为1000，每次把一千行数据写入或者复制到新建的工作表中，当然也可以新建工作簿，再把数据写入其中的工作表中并保存成指定规则的名称。几十万条数据分成几百个表，运行代码可能也就几分钟就完事了。不过写代码需要一些时间的。思路如上，可参考。