将Excel表数据拆分为多个Sheet表

1、数据拆分函数

Sub 拆分行数()
    Dim I As Long, N As Long
    Dim C As Long, Sh As Worksheet
    Application.ScreenUpdating = False
    C = Val(InputBox("请输入数据拆分行数"))
    If C = 0 Then Exit Sub
    Set Sh = ThisWorkbook.Worksheets(1) '要拆分的表'
    For I = 1 To ThisWorkbook.Worksheets(1).UsedRange.Rows.Count Step C
        With ThisWorkbook.Worksheets.Add(after:=Worksheets(ThisWorkbook.Worksheets.Count))
            Sh.Rows(I).Resize(C).Copy .Range("A1")
            N = N + 1
            .Name = N
        End With
    Next
    Application.ScreenUpdating = True
    MsgBox "共拆分出 " & N & "个工作表"
End Sub

2、执行过程(操作步骤)


 (a). 打开需要拆分的Excel表格
 
 (b). 右键工作表标签(需要拆分的Sheet页)
 
 (c). 点击 '查看代码(可使用快捷键 V)'
 
 (d). 粘贴代码(步骤 1 中的代码 数据拆分函数)
 
 (e). 运行代码'(可以使用快捷键 F5)'
 
 (f). 输入 数据拆分行数(每页拆分多少条)
 
 (g). 点击确定, 执行方法
 
 (h). 结束

3、处理Excel弹出提示:" 请注意!您的文档的部分内容可能包含文档检测器无法删除的个人信息。"

 
 (a). 点击 '文件'
 
 (b). 点击 '选项'
 
 (c). 点击 '信任中心'
 
 (d). 点击 '信任中心设置'
 
 (e). 点击 '个人信息选项'
 
 (f).'文档特定设置中'
 
 		  取消勾选 ' 保存时从文件属性中删除个人信息(R)'
 
 (g). 点击确定
 
 (h). 结束

4、方法二:手动调整代码中的三个数据,数据总量和拆分量

数据总量 ----> 对应下方代码块的 2000
拆分量 ----> 对应下方代码块的 500
拆分后每页数据量 ----> 对应下方代码块的 499 (500-1,1 是表头标题)
Sub split()
Dim i&
For i = 1 To 2000 Step 500
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = i
    Range("a" & i & ":iv" & i + 499).Copy Sheets(Sheets.Count).[a1]
Next i
End Sub
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值