Note: The other languages of the website are Google-translated. Back to English

如何在Excel中为每一行创建新工作表?

假设您在 A 列中有一个包含所有学生姓名的分数表。现在您要根据 A 列中的这些姓名创建新工作表,并使每张工作表包含唯一的学生数据。 或者只为表中的每一行创建新工作表,而不考虑 A 列中的名称。在本视频中,您将获得实现它的方法。

使用VBA代码为每一行创建新的工作表
使用Kutools for Excel的Split Data实用程序为每一行创建新工作表


使用VBA代码为每一行创建新的工作表

使用以下代码,您可以基于列值创建新的工作表,或者只为Excel中的每一行创建新的工作表。

1。 按 其他 + F11 同时打开 Microsoft Visual Basic应用程序 窗口。

2。 在里面 Microsoft Visual Basic应用程序 窗口中,单击 插页 > 模块。 然后将以下代码粘贴到 模块 窗口。

VBA代码:基于列为每一行创建新的工作表

Sub parse_data()
'Update by Extendoffice 2018/3/2
    Dim xRCount As Long
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim I As Long
    Dim xTRrow As Integer
    Dim xCol As New Collection
    Dim xTitle As String
    Dim xSUpdate As Boolean
    Set xSht = ActiveSheet
    On Error Resume Next
    xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
    xTitle = "A1:C1"
    xTRrow = xSht.Range(xTitle).Cells(1).Row
    For I = 2 To xRCount
        Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
    Next
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For I = 1 To xCol.Count
        Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
        Set xNSht = Nothing
        Set xNSht = Worksheets(CStr(xCol.Item(I)))
        If xNSht Is Nothing Then
            Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
            xNSht.Name = CStr(xCol.Item(I))
        Else
            xNSht.Move , Sheets(Sheets.Count)
        End If
        xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
        xNSht.Columns.AutoFit
    Next
    xSht.AutoFilterMode = False
    xSht.Activate
    Application.ScreenUpdating = xSUpdate
End Sub

备注:A1:C1是表的标题范围。 您可以根据需要进行更改。

3。 按 F5 键来运行代码,然后在当前工作簿的所有工作表之后创建新的工作表,如下图所示:

如果要直接为每行创建新的工作表而不考虑列值,则可以使用以下代码。

VBA代码:直接为每一行创建新工作表

Sub RowToSheet()
	Dim xRow As Long
	Dim I As Long
	With ActiveSheet
		xRow = .Range("A" & Rows.Count).End(xlUp).Row
		For I = 1 To xRow
			Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I
			.Rows(I).Copy Sheets("Row " & I).Range("A1")
		Next I
	End With
End Sub

运行代码后,活动工作表中的每一行都将放置在新工作表中。

备注:标题行也将与此VBA代码一起放在新工作表中。


使用Kutools for Excel的Split Data实用程序为每一行创建新工作表

实际上,上述方法是复杂且难以理解的。 在本节中,我们向您介绍 拆分数据 实用程序 Kutools for Excel.

申请前 Kutools for Excel首先下载并安装.

1.选择您需要用于创建新表的表,然后单击 Kutools 加> 吐出数据。 看截图:

2。 在里面 将数据拆分为多个工作表 对话框,请执行以下操作。

A.基于列值创建新表:

1)。 请选择 特定栏 选项,然后在下拉列表中指定要用于拆分数据的列;
2)。 如果要使用列值命名工作表,请选择 列的值规则 下拉列表;
3)。 点击 OK 按钮。 看截图:

B.为每行直接创建新的工作表:

1)。 选择 固定行 选项,输入数字 1 放进盒子里
2)。 选择 行号 来自 规则 下拉列表;
3)。 点击 OK 按钮。 看截图:

将创建一个新工作簿,其中包含所有新工作表。 请参见下面的屏幕截图。

根据列值为每一行创建新的工作表:

在不考虑列值的情况下为每一行创建新的工作表:

  如果您想免费试用(30-day) 这个实用程序, 请点击下载,然后按照上述步骤进行操作。

使用Kutools for Excel的Split Data实用程序为每一行创建新工作表


最佳办公效率工具

Kutools for Excel解决了您的大多数问题,并使您的生产率提高了80%

  • 重用: 快速插入 复杂的公式,图表 以及您以前使用过的任何东西; 加密单元 带密码 创建邮件列表 并发送电子邮件...
  • 超级公式栏 (轻松编辑多行文本和公式); 阅读版式 (轻松读取和编辑大量单元格); 粘贴到过滤范围...
  • 合并单元格/行/列 不会丢失数据; 拆分单元格内容; 合并重复的行/列...防止细胞重复; 比较范围...
  • 选择重复或唯一 行; 选择空白行 (所有单元格都是空的); 超级查找和模糊查找 在许多工作簿中; 随机选择...
  • 确切的副本 多个单元格,无需更改公式参考; 自动创建参考 到多张纸; 插入项目符号,复选框等...
  • 提取文字,添加文本,按位置删除, 删除空间; 创建和打印分页小计; 在单元格内容和注释之间转换...
  • 超级滤镜 (将过滤方案保存并应用于其他工作表); 高级排序 按月/周/日,频率及更多; 特殊过滤器 用粗体,斜体...
  • 结合工作簿和工作表; 根据关键列合并表; 将数据分割成多个工作表; 批量转换xls,xlsx和PDF...
  • 超过300种强大功能. 支持 Office / Excel 2007-2021 和 365。支持所有语言。 在您的企业或组织中轻松部署。 完整功能 30 天免费试用。 60 天退款保证。
kte选项卡201905

Office选项卡为Office带来了选项卡式界面,使您的工作更加轻松

  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,发布者,Access,Visio和Project。
  • 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
  • 每天将您的工作效率提高50%,并减少数百次鼠标单击!
officetab底部
按评论排序
注释 (33)
还没有评分。 成为第一位评论!
该评论由网站上的主持人最小化
您好,我想根据我的模板文件 Myformat 创建工作表,并根据第一列数据命名它们。 我自定义了 VBA 代码如下,但它生成了太多的空白表。 你能帮我停止生成空白纸吗? 谢谢你。 Kumar Sub AddSheets() Dim cell As Excel.Range Dim wsWithSheetNames As Excel.Worksheet Dim wbToAddSheetsTo As Excel.Workbook Set wsWithSheetNames = ActiveSheet Set wbToAddSheetsTo = ActiveWorkbook For Each cell in wsWithSheetNames.Range("A2:A165") With wbToAddSheetsTo .Sheets。添加之后:=ActiveSheet Sheets.Add 类型:= _ "C:\Users\Dimple\AppData\Roaming\Microsoft\Templates\MyFormat.xltx" On Error Resume Next ActiveSheet.Name = cell.Value If Err.Number = 1004 Then Debug.Print cell.Value & "已经用作工作表名称" End If On Error GoTo 0 End With Next cell End Sub
该评论由网站上的主持人最小化
嗨,
我总是在 A 行上的每个唯一条目获得 2 张纸。 知道为什么吗? 此外,将生成的工作表创建的总行数添加到工作表名称有多困难。 非常感谢! 如果您接受捐款,请告诉我。
该评论由网站上的主持人最小化
您好,我想使用我的 exel 文件模板 MyFormat 生成工作表并通过第一列上的数据命名工作表。 以下 VBA 代码可以按照 MyFormat 生成工作表。 但它也在普通的 excel 模板上生成数百张空白页。 可以请一些人帮助我停止生成多余的空白纸。 感谢 Kumar Sub AddSheets() Dim cell As Excel.Range Dim wsWithSheetNames As Excel.Worksheet Dim wbToAddSheetsTo As Excel.Workbook Set wsWithSheetNames = ActiveSheet Set wbToAddSheetsTo = ActiveWorkbook For Each cell in wsWithSheetNames.Range("A2:A165") With wbToAddSheetsTo .Sheets .Add After:=ActiveSheet Sheets.Add Type:= _ "C:\Users\Dreamline\AppData\Roaming\Microsoft\Templates\MyFormat.xltx" On Error Resume Next ActiveSheet.Name = cell.Value If Err.Number = 1004然后 Debug.Print cell.Value & "已经用作工作表名称" End If On Error GoTo 0 End With Next cell End Sub
该评论由网站上的主持人最小化
工作表名称的长度必须小于或等于 XNUMX 个字符。
不是很常见的知识,但否则代码将输出默认的空白“Sheet #”工作表。

创建一个新的工作表,您的解析代码将运行它并引用第一列,如下所示:
=IF(OR('参考原稿'!B1<>"", LEN('参考原稿'!B1)>30), LEFT('参考原稿'!B1,30),'参考原稿'!B1)


尽可能复制或参考工作表的其余部分。 如果您在引用其他工作表时遇到任何问题,请确保该列没有数据验证限制。
该评论由网站上的主持人最小化
非常感谢你发布这个!!!! 像魅力一样工作。 你能解释一下第一组代码是如何工作的吗?
该评论由网站上的主持人最小化
这次真是万分感谢!



在 VBA 代码中是否有从第一列和第二列行数据组合的结果表命名?



所以对于您的示例表 2 将自动命名为“linda 100”
该评论由网站上的主持人最小化
亲爱的乔伊斯:
谢谢你的评论! 希望下面的 VBA 脚本可以帮助你。

子 parse_data()
将 xRCount 变暗
将 xSht 调暗为工作表
将 xNSht 调暗为工作表
暗淡我只要
将 xTRrow 调暗为整数
Dim xCol 作为新系列
将 xTitle 调暗为字符串
出错时继续下一步
Application.ScreenUpdating = False
设置 xSht = ActiveSheet
xRCount = xSht.UsedRange.End(xlDown).Row
xTitle = "A1:B1"
xTRrow = xSht.Range(xTitle).Row
对于 I = 2 到 xRCount
调用 xCol.Add(CStr(xSht.Cells(I, 1)), CStr(xSht.Cells(I, 1)))
下一页
调试打印 xCol.Count
对于 I = 1 到 xCol.Count
调用 xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
设置 xNSht = 无
设置 xNSht = Worksheets(CStr(xCol.Item(I)))
如果 xNSht 什么都不是,那么
设置 xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I) & xSht.Cells(I + 1, 2))
其他
xNSht.Move , Sheets(Sheets.Count)
结束如果
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
下一页
xSht.AutoFilterMode = False
xSht.激活
Application.ScreenUpdating =真
END SUB
该评论由网站上的主持人最小化
这非常有帮助,正是我想要的。 谢谢!
该评论由网站上的主持人最小化
这段代码非常有用,几乎是我想要的。
但是可以调整成有两张纸吗-
表 1 是数据 - 以 A 列为名称的数据表
Sheet 2 是一个模板,有许多需要填写的字段
我希望的是运行一个宏,它将
1 复制粘贴模板,在同一个文件中,将工作表命名为单元格 A1 中的名称
2 复制单元格 B1 然后粘贴到新模板中的选定字段
3 沿第 1 行重复直到空
4 然后重复第 2 行和每一行直到结束。
结果是一个带有 x 号的文件。 工作表与模板相同,所有字段均已填写。
我继承了一个以另一种方式工作的文件,将数据从模板提取到表中,但无法反转它.....
该评论由网站上的主持人最小化
亲爱的山姆,
如果您能在此处附上您的工作簿,那就太好了。
您可以使用下面的上传文件按钮上传您的文件。
该评论由网站上的主持人最小化
您好,我尝试使用您的代码,但出现错误
运行时错误“1004”:
应用程序定义或对象定义的错误
我对 VBA(或任何相关技术)一无所知,但如果按调试它会突出显示第 11 行 xRCount=xSht.Cells(xSht.Rows.Count,1)。 结束(xIUp).Row
我正在处理一个有 127 列和 337 行的大文件(行会改变列不会),它是一个包含我的数字及其详细信息的列表。
我确实按照您的说明更改了范围,但仍然无法正常工作我正在使用 Excel 2010,如果可能的话,您能否告诉我如何使其工作
谢谢
该评论由网站上的主持人最小化
亲爱的比阿特丽斯,
代码随问题解决而更新。 请再试一次。 感谢您的评论。
该评论由网站上的主持人最小化
你好,我认为这里有一些对我的情况有用的东西,但我可以做 VBA 或脚本,希望你能提供帮助。
我有一个带有许多单元格的模板来填充数据,并且会有一个我想输入到模板中的搜索键(非唯一)。 根据搜索关键字,对数据进行搜索,并取出匹配关键字上的对应数据并填充到模板中。 填充的模板被保存到一个新的工作表中。 可能有超过 1 个匹配条目。 我需要脚本继续在列表中搜索,直到选择了所有匹配项,并创建了一定数量的新工作表。
该评论由网站上的主持人最小化
嗨,有没有办法在每个新工作表上保留标题行? (在我的附件中用红色圈出)

该代码从我的主工作表中获取所有行并将它们转移到新的工作表中,这很棒。 但我想在每个新工作表的顶部保留我的“主”标题值(以红色圈出)。 谢谢!



我指的是上面的这段代码:

子 RowToSheet()
将 xRow 变暗
暗淡我只要
使用ActiveSheet
xRow = .Range("A" & Rows.Count).End(xlUp).Row
对于 I = 1 到 xRow
Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row" & I
.Rows(I).Copy Sheets("Row" & I).Range("A1")
接下来我
结束
END SUB
该评论由网站上的主持人最小化
很棒的代码,但是如果我的数据在 G 列而不是 A 列上,我能得到一些帮助吗? 我需要更改什么才能将 G 列数据放在不同的选项卡中?

谢谢
该评论由网站上的主持人最小化
这是很棒的代码。 非常感谢 OfficeExtend 的大脑盒! 无论如何,这段代码是否可以稍微适应为每个 *column* 而不是行创建单独的工作表? 我附上了一张我正在努力实现的图片。 这可能吗? 亲切的问候。
该评论由网站上的主持人最小化
美好的一天,
我在这里没有看到你的照片。
该评论由网站上的主持人最小化
嗨,如果我的名字字段在C列,如何修改代码
该评论由网站上的主持人最小化
嗨,阿卜杜勒·巴斯特,
下面的 VBA 代码可以帮助你。 请试一试。
行中:xCName = "3",3表示Excel中的列号(这里是C列)。 您可以根据需要将其更改为任何列号。

子 parse_data()
'更新者 Extendoffice 2018/3/2
将 xRCount 变暗
将 xSht 调暗为工作表
将 xNSht 调暗为工作表
暗淡我只要
将 xTRrow 调暗为整数
Dim xCol 作为新系列
将 xTitle 调暗为字符串
将 xSUpdate 调暗为布尔值
将 xCName 调暗为整数
将 xTA、xRA、xSRg1 调暗为字符串
设置 xSht = ActiveSheet
出错时继续下一步
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTitle = "A1:C1"
xCName = "3" '将此编号更改为您将根据其创建新工作表的列号
xTRrow = xSht.Range(xTitle).Cells(1).Row
对于 I = 2 到 xRCount
调用 xCol.Add(xSht.Cells(I, xCName).Text, xSht.Cells(I, xCName).Text)
下一页
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
xSRg = xSht.Cells(1, xCName).Address(RowAbsolute:=False, ColumnAbsolute:=False)
对于 I = 1 到 xCol.Count
调用 xSht.Range(xTitle).AutoFilter(xCName, CStr(xCol.Item(I)))
设置 xNSht = 无
设置 xNSht = Worksheets(CStr(xCol.Item(I)))
如果 xNSht 什么都不是,那么
设置 xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I))
其他
xNSht.Move , Sheets(Sheets.Count)
结束如果
xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
xNSht.Columns.AutoFit
下一页
xSht.AutoFilterMode = False
xSht.激活
Application.ScreenUpdating = xSUpdate
END SUB
该评论由网站上的主持人最小化
很酷的 VBA 代码可以解决问题。

如何将其修改为不复制第一列? 并删除列名?

问候
该评论由网站上的主持人最小化
请我获得有关如何使用特定列自动命名工作表的帮助。 这是用于工作表 VBA 的行。 见下文

子 RowToSheet()

将 xRow 变暗

暗淡我只要

使用ActiveSheet

xRow = .Range("A" & Rows.Count).End(xlUp).Row

对于 I = 1 到 xRow

Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row" & I

.Rows(I).Copy Sheets("Row" & I).Range("A1")

接下来我

结束

END SUB
该评论由网站上的主持人最小化
没关系,它是隐藏的尾随空格。 我使用了 TRIM 功能并对其进行了清理。 有一个行数(行数确实如此,所以在工作表前面加上行 -1 会很棒)
该评论由网站上的主持人最小化
如何参考上面代码的使用(信用)? 是否可以修改代码?
该评论由网站上的主持人最小化
你好,这是一个开放的交流平台。 代码允许引用和修改。
该评论由网站上的主持人最小化
娜娜
86
2
该评论由网站上的主持人最小化
你好! 我刚刚使用了这段代码,它奏效了! 除了为每个条目创建一个新工作表之外,我还想将其转换为列并且无法弄清楚。 所以对于上面的例子,娜娜的输出看起来像这样 - 姓名: 娜娜评分 86没有 2
该评论由网站上的主持人最小化
您好,使用此代码并且有效,但是如果我想在标题中选择多行,代码中会有什么变化? 我在每张纸上都有我想要的多行。
该评论由网站上的主持人最小化
你好,你知道怎么做吗?
该评论由网站上的主持人最小化
嗨,是否有一个代码在每次运行宏时只添加 1 个新工作表,例如,第一次新工作表将在单元格 A1 的内容上命名,第二次运行宏时,新工作表将在A1等的内容感谢期待
这里还没有评论
加载更多
留下你的意见
以访客身份发帖
×
评价此帖子:
0   产品特性
建议地点

关注我们

版权所有 © 2009 - extendoffice.com。 | 版权所有。 供电 ExtendOffice。 | 网站地图
Microsoft和Office徽标是Microsoft Corporation在美国和/或其他国家的商标或注册商标。
受Sectigo SSL保护