如何将1个Excel工作簿的数据拆分成若干个工作簿

有时候一个Excel的数据会很多，需要拆分成若干个工作簿，比如把1个40万行的excel，按每个工作簿40000行，拆成10个；思路是先把原始文件复制10个，然后逐个打开，按顺序把多余的删除：

另一种方法是先分拆成多个工作表，然后再将工作表拆成独立的工作簿文件

Sub 拆分()

Workbooks.Open (ThisWorkbook.Path & "/原始.xlsx")  '打开原始文件

r = 1 '标题行有几行，一般就是数字1

b = 40000            '拆分后每个工作簿有多少数据

a = ActiveWorkbook.Worksheets(1).UsedRange.Rows.Count '原始文件有几行

ActiveWorkbook.Close

l = Int(a / b) + 1      'l表示可以拆分成几个文件

For i = 1 To l

FileCopy ThisWorkbook.Path & "/原始.xlsx", ThisWorkbook.Path & "/" & i & ".xlsx"

Next i

'把文件复制成l份

Application.ScreenUpdating = False

fn = ThisWorkbook.Path & "/" & 1 & ".xlsx"    '将第1个要汇总的工作簿名称赋给变量fn

Workbooks.Open (fn)

With ActiveWorkbook.Worksheets(1)

    Rows(r + b + 1 & ":" & 1048576).Select

    Selection.Delete Shift:=xlUp

End With

ActiveWorkbook.Close savechanges:=True

'第1个文件比较特殊

For i = 2 To l

    fn = ThisWorkbook.Path & "/" & i & ".xlsx"

    Workbooks.Open (fn)

    With ActiveWorkbook.Worksheets(1)

        Rows(r + 1 & ":" & r + (i - 1) * b).Select

        Selection.Delete Shift:=xlUp

        Rows(r + b + 1 & ":" & 1048576).Select

        Selection.Delete Shift:=xlUp

    End With

    ActiveWorkbook.Close savechanges:=True

Next i

Application.ScreenUpdating = True

'从第2个文件开始把不需要的都删除

End Sub