[已解决]如何将一个工作表的数据拆分成多个工作簿?

cdc811 · 发表于 2022-1-21 20:43

本帖最后由 cdc811 于 2022-1-21 20:51 编辑

如何将一个工作表的数据拆分成多个工作簿：
1、总共有20000多行数据，如何按1000行数据拆分一个工作簿；
2、A~Z列都有数据；
3、标题行数为3行，即拆分后的工作簿保留三行标题内容；
4、拆分工作簿的文件名为对应A列中的序号，如1.xls、1000.xls、2000.xls、3000.xls
请高手帮忙！！！

---------------------------
下面的代码拆分后只有一个A列数据，如果A~Z列都有数据，如何将下面的代码修改一下呢？

'如下Excel表，总共有120多行数据，以50行数据为一个工作表进行拆分
Sub ZheFenSheet()
Dim r, c, i, WJhangshu, WJshu, bt As Long
r = Range("A" & Rows.Count).End(xlUp).Row
b = InputBox("请输入分表行数")
If IsNumeric(b) Then
WJhangshu = Int(b)
Else
MsgBox "输入错误", vbOKOnly, "错误"
End
End If
c = Cells(1, Columns.Count).End(xlToLeft).Column
bt = 3 '标题行数
'WJhangshu = 50 '每个文件的行数
WJshu = IIf(r - bt Mod WJhangshu, Int((r - bt) / WJhangshu), Int((r - bt) / WJhangshu) + 1)
'------
Set fs = CreateObject("Scripting.FileSystemObject") '
For i = 0 To WJshu
Workbooks.Add
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & Format(i + 1, String(Len(WJshu), 0)) & "." & fs.GetExtensionname(ThisWorkbook.FullName) '扩展名
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

复制代码

最佳答案

月排行榜 / 总排行榜

hhxq001

2022-1-22 14:35

本帖最后由 hhxq001 于 2022-1-23 12:13 编辑

试一试我收藏的这个，能不能满足需要

1个表-拆分成多个独立的文件.zip (29.09 KB, 下载次数: 22)

Yunyun123 · 发表于 2022-1-21 22:40

ThisWorkbook.ActiveSheet.Range("A" & bt + i * WJhangshu + 1).Resize(WJhangshu, c).Copy _
ActiveSheet.Range("A" & bt + 1) 这是指copy了A列的数据啊。要copy的是从A 列到最后一列的数据库，要用的是一个区域。

hhxq001 · 发表于 2022-1-22 14:35

这个最佳答案由 hhxq001 给出，感谢 hhxq001 的回答。

单击隐藏图章

本帖最后由 hhxq001 于 2022-1-23 12:13 编辑

试一试我收藏的这个，能不能满足需要

1个表-拆分成多个独立的文件.zip (29.09 KB, 下载次数: 22)

cdc811 · 发表于 2022-1-22 20:21

hhxq001 发表于 2022-1-22 14:35
试一试我收藏的这个，能不能满座要求

您的收藏正是我所需要的宝贝，非常感谢！

hhxq001 · 发表于 2022-1-23 12:13

cdc811 发表于 2022-1-22 20:21
您的收藏正是我所需要的宝贝，非常感谢！

也是论坛里找的，忘了链接地址。

		自动登录	找回密码
密码			注册