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?

 一、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