WPS 2019 How To Create New Sheets For Each Row In Excel?

https://www.extendoffice.com/documents/excel/3197-excel-create-new-sheet-for-each-row.html  How To Create New Sheets For Each Row In Excel?

https://www.extendoffice.com/zh-CN/documents/excel/1174-excel-split-data-into-multiple-worksheets-based-on-column.html

一、create new sheet for each row based on column

案例介绍：

VBA code: create new sheet for each row based on column

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

1. 开发工具 -- VB编辑器

2. 插入 -- 模块

3. 运行代码

4. 运行后的效果：

自动新建sheet页：

各个sheet页数据：

二、VBA code: Directly create new sheet for each row

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

效果：

根据每一行拆分成各sheet页

... etc