Note: The other languages of the website are Google-translated. Back to English
Увійти  \/ 
x
or
x
Реєстрація  \/ 
x

or

Як створити нові аркуші для кожного рядка в Excel?

Припустимо, у вас є таблиця оцінок з усіма іменами студента у стовпці A. Тепер ви хочете створити нові аркуші на основі цих імен у стовпці A, і make на аркуші містить одні унікальні дані студента. Або просто створіть новий аркуш для кожного рядка таблиці, не враховуючи назву в стовпці А. У цій статті ви знайдете методи його досягнення.

Створіть нові аркуші для кожного рядка з кодом VBA
Створіть нові аркуші для кожного рядка за допомогою утиліти «Розділити дані» Kutools для Excel


Створіть нові аркуші для кожного рядка з кодом VBA

За допомогою наступних кодів ви можете створити новий аркуш на основі значень стовпців або просто створити нові аркуші для кожного рядка в Excel.

1. прес інший + F11 клавіші одночасно, щоб відкрити Microsoft Visual Basic для додатків вікна.

2 В Microsoft Visual Basic для додатків вікна, натисніть Insert > Модулі. А потім вставте наступний код у Модулі вікна.

Код 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 для Excel

Насправді, вищезазначений метод є складним і важким для розуміння. У цьому розділі ми представляємо вам Розділити дані корисність Kutools для Excel.

Перед поданням заявки Kutools для Excel, будь ласка завантажте та встановіть його спочатку.

1. Виберіть таблицю, яку потрібно використовувати для створення нових аркушів, а потім клацніть Kutools Plus> Дані коси. Дивіться знімок екрана:

2 В Розділіть дані на кілька аркушів діалогове вікно, будь ласка, виконайте наступне

А. Для створення нових аркушів на основі значення стовпця:

1). Виберіть Конкретний стовпець параметр і вкажіть стовпець, за яким потрібно розділити дані, виходячи зі спадного списку;
2). Якщо ви хочете назвати робочі аркуші значеннями стовпців, виберіть Значення стовпця в Правила випадаючий список;
3). Клацніть на OK кнопку. Дивіться знімок екрана:

B. Для безпосереднього створення нових аркушів для кожного рядка:

1). Виберіть Фіксовані ряди , введіть номер 1 у коробку;
2). Виберіть Номери рядків від Правила випадаючий список;
3). Клацніть на OK кнопку. Дивіться знімок екрана:

створюється нова робоча книга з усіма новими аркушами всередині. Дивіться скріншоти нижче.

Створення нових аркушів для кожного рядка на основі значення стовпця:

Створення нового аркуша для кожного рядка без урахування значення стовпця:

  Якщо ви хочете отримати безкоштовну (30-денну) пробну програму, натисніть, щоб завантажити, а потім перейдіть до застосування операції, як описано вище.

Створіть нові аркуші для кожного рядка за допомогою утиліти «Розділити дані» Kutools для Excel


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

  • Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
  • Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
  • Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
  • Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
  • Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
  • Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
  • Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
  • Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
  • Понад 300 потужних функцій. Підтримує Office / Excel 2007-2019 та 365. Підтримує всі мови. Простота розгортання на вашому підприємстві чи в організації. Повна функція 30-денної безкоштовної пробної версії. 60-денна гарантія повернення грошей.
вкладка kte 201905

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    sooty12 · 3 months ago
    Hi, is there a code which would add only 1 new sheet each time the macro is run, eg 1st time the new sheet would be named on the contents of cell A1, 2nd time the macro was run the new sheet would be named on the contents of A2 etc.   thanks in anticipation
  • To post as a guest, your comment is unpublished.
    patelbr218 · 4 months ago
    Hello, used this code and worked, but If I want select the more then one rows in header, what will be change in the code ? I have multiple lines in the sheet which I want in every sheet.
  • To post as a guest, your comment is unpublished.
    bvrs8584 · 4 months ago
    Hello! I just used this code and it worked! In addition to creating a new sheet for each entry, I want to transpose it to columns and can't figure it out. So for the above example, the output for Nana would look like this - 
    Name  Nana
    Score  86
    No.      2
  • To post as a guest, your comment is unpublished.
    bvrs8584 · 4 months ago

       Nana
       86
           2

  • To post as a guest, your comment is unpublished.
    prog2020py · 9 months ago
    How to reference the use of the code above (credit) ? Is it possible to modify the code ?
    • To post as a guest, your comment is unpublished.
      crystal · 9 months ago
      Hi, this is an open communication platform. The code is allowed to reference and modify.
  • To post as a guest, your comment is unpublished.
    Jesse · 10 months ago
    Nevermind it was hidden trailing spaces. I used the TRIM feature and cleaned it up. Having a row count (line count really so rows -1 prepended to the sheet would be amazing)
  • To post as a guest, your comment is unpublished.
    Omotayo · 1 years ago
    Please can i get help on how to automatically name the sheets using a particular column. This is for the row to sheet VBA. See below

    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
  • To post as a guest, your comment is unpublished.
    chustm.listas@gmail.com · 1 years ago
    Cool VBA code to do the trick.

    How can I modify it to not to copy the first column? And to remove the column name?

    Regards
  • To post as a guest, your comment is unpublished.
    Abdul Basit · 2 years ago
    Hii , how to modify the code, if my name field is in C column
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Abdul Basit,
      The below VBA code can help you. Please have a try.
      In the line: xCName = "3", 3 indicates the column number (here is the C column) in Excel. You can change it to any column number as you need.

      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
      Dim xCName As Integer
      Dim xTA, xRA, xSRg1 As String
      Set xSht = ActiveSheet
      On Error Resume Next
      xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
      xTitle = "A1:C1"
      xCName = "3" 'Change this number to the column number which you will create new sheets based on
      xTRrow = xSht.Range(xTitle).Cells(1).Row
      For I = 2 To xRCount
      Call xCol.Add(xSht.Cells(I, xCName).Text, xSht.Cells(I, xCName).Text)
      Next
      xSUpdate = Application.ScreenUpdating
      Application.ScreenUpdating = False
      xSRg = xSht.Cells(1, xCName).Address(RowAbsolute:=False, ColumnAbsolute:=False)
      For I = 1 To xCol.Count
      Call xSht.Range(xTitle).AutoFilter(xCName, 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
  • To post as a guest, your comment is unpublished.
    ComplianceHound · 2 years ago
    This is great code. Many thanks to brain-boxes at OfficeExtend !! Is there anyway this code could be slightly adapted to to create separate sheets for each *column* instead of row? I've attached a picture of what I'm trying to achieve. Is this possible? Kind regards.
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      I didn't see your picture here.
  • To post as a guest, your comment is unpublished.
    Sam · 2 years ago
    Great code, but could I get some help if I my data is on column G instead of column A? what do I need to change to have the Column G data in different tab?

    Thanks
  • To post as a guest, your comment is unpublished.
    Bubbly · 3 years ago
    Hi, is there a way to keep the heading row on each new worksheet? (circled in red on my attachment)

    The code takes all the rows from my master worksheet and transfers them into new worksheets, which is great. But I want to keep my "master" header value (circled in red) at the top of each new worksheet. Thanks!



    I'm referring to this code from above:

    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
  • To post as a guest, your comment is unpublished.
    tanbinkeong@gmail.com · 3 years ago
    Hello, I think there is something useful here for my situation, but I'm able to to do VBA or script, hope you can help.
    I have a template w/ many cells to fill with data, and there will be a search key (non unique) that I would like to enter into the template. Based on the search key, the data is searched and corresponding data on the matched key is fetched and filled into the template. The filled template is saved into a new worksheet. There maybe more than 1 match entries. I need the script to continue search down the list, until all matches are picked, and the certain number of new worksheets created.
  • To post as a guest, your comment is unpublished.
    Beatriz · 3 years ago
    Hello I tried to use your code but I get an error
    Run-timeerror '1004':
    Application-defined or object-defined error
    I have no knowledge of VBA (or any technology for that matter) but if a press debug it highlights line 11 xRCount=xSht.Cells(xSht.Rows.Count,1). End(xIUp).Row
    I am working with a large file that has 127 columns and 337 rows (rows will vary columns won't) and it is a list with I'd numbers and their details.
    I did change the range as you noted but still doesn't work I'm using Excel 2010 could you please tell me how to make it work if possible
    Thank you
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Beatriz,
      The code is updated with the problem solving. Please try it again. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    Sam · 3 years ago
    This code is is very helpful, and almost what i was looking for.
    But can it be adjusted such that there are two sheets -
    Sheet 1 is the Data - a table of data with Column A being the name
    Sheet 2 is a template, with numerous fields requiring filling
    What I was hoping is run a macro, which will
    1 Copy-paste the template, in the same file, name the sheet as the name in Cell A1
    2 Copy cell B1 then past to a selected field in the new template
    3 repeat along row 1 until empty
    4 then repeat for row 2 and each row until the end.
    Result is a file with x no. sheets all the same as the template, with all the fields filled in.
    I inherited a file which works the other way, extracting data from templates to a table, but cannot reverse it.....
    • To post as a guest, your comment is unpublished.
      crystal · 3 years ago
      Dear Sam,
      Would be nice if you could attach your workbook here.
      You can upload your file with the below Upload files button.
  • To post as a guest, your comment is unpublished.
    Mark · 4 years ago
    This was extremely helpful, just what I was looking for. Thanks!
  • To post as a guest, your comment is unpublished.
    Joyce · 4 years ago
    Thank you for this!



    In the VBA code is there anyway to name the resultant sheets from the first and second column row data combined?



    so for your example sheet 2 would be auto named "linda 100"
    • To post as a guest, your comment is unpublished.
      crystal · 4 years ago
      Dear Joyce,
      Thank you fr your comment! Hope the below VBA script can help you.

      Sub parse_data()
      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
      On Error Resume Next
      Application.ScreenUpdating = False
      Set xSht = ActiveSheet
      xRCount = xSht.UsedRange.End(xlDown).Row
      xTitle = "A1:B1"
      xTRrow = xSht.Range(xTitle).Row
      For I = 2 To xRCount
      Call xCol.Add(CStr(xSht.Cells(I, 1)), CStr(xSht.Cells(I, 1)))
      Next
      Debug.Print xCol.Count
      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) & xSht.Cells(I + 1, 2))
      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 = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Yaw · 4 years ago
    Thank you so much for posting this!!!! Worked like a charm.

    Can you explain how the first set of code works?
    • To post as a guest, your comment is unpublished.
      crystal · 4 years ago
      Dear Yaw,

      How do you mean "explain how the code work"? I am so sorry i can get your point.
  • To post as a guest, your comment is unpublished.
    Kumar · 5 years ago
    Hi there,

    I want to use my exel file template MyFormat to generate worksheets and name the worksheets by the data on the first column. The following VBA code is working ok to generate the worksheets as per MyFormat. But it is generating hundreds of blank sheets on normal excel templete too. Could some body please help me to stop generating excess blank sheets.

    Thanks
    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 Then
    Debug.Print cell.Value & " already used as a sheet name"
    End If
    On Error GoTo 0
    End With
    Next cell
    End Sub
    • To post as a guest, your comment is unpublished.
      Brandon · 3 years ago
      Worksheet Names must be less than or equal to thirty characters in length.
      Not very common knowledge, but otherwise the code will output a default blank "Sheet #" worksheet.

      Create a new worksheet that your parsing code will run through and reference the first column as follows:
      =IF(OR('Referenced Original'!B1<>"", LEN('Referenced Original'!B1)>30), LEFT('Referenced Original'!B1,30),'Referenced Original'!B1)


      Either copy over or reference the rest of the sheet as you may. Make sure the column is free of data validation restrictions if you have any problems referencing the other worksheet.
  • To post as a guest, your comment is unpublished.
    Kumar · 5 years ago
    Hi there,

    I want to create worksheets based on my template file Myformat and name them as per the first column data. I customized the VBA code as following, but it is generating too much blank sheets. Could you please help me to stop generating blank sheets.

    Thank you.
    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\Dimple\AppData\Roaming\Microsoft\Templates\MyFormat.xltx"
    On Error Resume Next
    ActiveSheet.Name = cell.Value
    If Err.Number = 1004 Then
    Debug.Print cell.Value & " already used as a sheet name"
    End If
    On Error GoTo 0
    End With
    Next cell
    End Sub
    • To post as a guest, your comment is unpublished.
      Jesse · 10 months ago
      Hi,

      I always get 2 sheets per unique entry on A row. Any idea why? Also how difficult would it be to prepend the total amount of rows the generated sheet creates to the sheet name. Thanks so much! Let me know if you take donations.