Question

如何将excel总表拆分为多个附表

我有一张15W条数据的execl总表（只有A列有数据），我需要导入某系统，系统单次导入上限为5000条。
问题是：如何用快捷的方法将15w的总表拆分为N个只有5000条数据的excel表？请不要说手工复制，粘贴这样的弱智回答，谢谢！

Answer 1

用VBA宏

下面的宏，放到你的原来表格中（注意做好表格备份，防止失误），运行即可，在同一文件夹得到拆分的多个附表。

Sub splitExcel_by_zzllrr()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim TPath As String, XSheet As Worksheet, sht0 As Worksheet
    
    Set sht0 = Sheets(1)
    
    For i = 1 To 30
        '上面30是设置的附表总数，如果不知15w数据，可以根据实际情况，设置大一点。
        
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "newSheet_" & i
        
        sht0.Range("A" & ((i - 1) * 5000 + 1) & ":A" & (i * 5000)).Copy Sheets("newSheet_" & i).Range("A1")
        
    
    Next i
    
    
    
    TPath = ActiveWorkbook.Path
    For Each XSheet In ActiveWorkbook.Sheets
        If XSheet.Name Like "newSheet_*" Then
            XSheet.Copy
            ActiveWorkbook.SaveAs Filename:=TPath & "\" & ActiveSheet.Name & ".xls"
            ActiveWindow.Close
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

追问

谢谢！这些代码写到哪里？

追答

你随便录制一个宏，然后编辑你的宏代码，用我的代码替换一下，保存后即可用了

追问

太棒了，完美解决！多谢！

Answer 2

做一个小宏
用一个paste函数
需要的话下午帮你做一下

追问

谢谢。需要

追答

Sub abc()

ii = Sheets("原始数据").[a1].CurrentRegion.Rows.Count

n = Application.WorksheetFunction.RoundUp(ii / 5000, 0)

For i = 1 To n

 Rows(5000 * i - 4999 & ":" & 5000 * i).Select

    Selection.Copy

    Sheets.Add After:=Sheets(i)

    Sheets(i).Paste

Sheets("原始数据").Select

Next i

Dim c As Worksheet

Application.ScreenUpdating = False

lj = ThisWorkbook.Path & "\"

For Each c In Sheets

    c.Copy

    ActiveWorkbook.SaveAs jl & "拆分" & c.Name & ".xls"

    ActiveWorkbook.Close

Next

Application.ScreenUpdating = True

End Sub