Create new sheets for each row with VBA code

 

Create new sheets for each row with VBA code

With the following codes, you can create new sheet based on column values, or just create new sheets for each row in Excel.

1. Press Alt + F11 keys simultaneously to open the Microsoft Visual Basic for Applications window.

2. In the Microsoft Visual Basic for Applications window, click Insert > Module. And then paste the following code into the Module window.

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

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

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

Note: A1:C1 is the title range of your table. You can change it based on your needs.

3. Press F5 key to run the code, then new worksheets are created after all worksheets of the current workbook as below screenshot:

If you want to directly create new sheets for each row without considering the column value, you can use the following code.

VBA code: Directly create new sheet for each row

1 2 3 4 5 6 7 8 9 10 11

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

After running the code, each row in active worksheet will be placed in a new worksheet.

Note: The heading row will also be placed in a new sheet with this VBA code.