如何把EXCEL表中每一行单独另存为一个EXCEL文件

发布网友 发布时间：2022-04-22 02:13

我来回答

共3个回答

热心网友 时间：2023-10-06 19:40

'功能：用当前工作薄每条记录创建一个新的工作薄，每个新建工作薄以第一行为标题行，第二行为记录，以A列记录为工作薄名称自动保存。
'友情提示：
1、如何把下面的代码添加到VBA环境：点击“开发工具”－“visual Basic”进入vba编辑环境，在左侧的“工程”树里点击鼠标右键，选择“插入”－“模块”，然后把下面的代码粘贴到右侧的编辑区里。
2、如何使用：可创建热键调用，也可点击“开发工具”－“visual Basic”进入vba编辑环境，在该过程代码里点击一下，然后点击工具栏上的运行按钮（是一个实心三角形，鼠标放上去停留一会，有提示“运行子过程/...”）。

Sub SplitExl()
Application.DisplayAlerts = False '新建的文档存在时，不发送警示，覆盖式保存

Dim lngRs&, lngCs&, cx&, strEndCl$
Dim topR(), EveryR(), oExl As Object, oWk As Workbook
Dim strPath$
strPath = ThisWorkbook.Path & "\"

With ActiveSheet.UsedRange
lngRs = .Rows.Count
lngCs = .Columns.Count
End With
strEndCl = Replace(Replace(Cells(1, lngCs).Address, "$", ""), "1", "")

topR = Range("A1:" & strEndCl & "1") '数据标题行
For cx = 2 To lngRs
EveryR = Range("A" & Format(cx) & ":" & strEndCl & Format(cx)) '把每行记录放入数组

Set oWk = Application.Workbooks.Add

With oWk
'.Parent.Visible = True
With .Sheets(1)
.Range("A1:" & strEndCl & "1") = topR '把标题行放入另建的工作薄
.Range("A2:" & strEndCl & "2") = EveryR '把单个记录放入同一另建的工作薄
End With
.SaveAs Filename:=strPath & EveryR(1, 1) & ".xls" '以每行A列记录为工作薄名称
.Close
End With
Next

Set oWk = Nothing
Set oExl = Nothing

Erase topR: Erase EveryR

Application.DisplayAlerts = True
End Sub

热心网友 时间：2023-10-06 19:40

在菜单栏找数据--筛选--自动筛选追问要另存为一个新的EXCEL表

热心网友 时间：2023-10-06 19:41

用宏真快，可以自己写一个。追问要是会的话就不麻烦大家了~~