Note: The other languages of the website are Google-translated. Back to English
Zaloguj Się  \/ 
x
or
x
Rejestruję się  \/ 
x

or

Jak podzielić dane na wiele arkuszy roboczych na podstawie kolumny w programie Excel?

Przypuśćmy, że masz arkusz z ogromnymi wierszami danych, a teraz musisz podzielić dane na wiele arkuszy na podstawie Imię i nazwisko kolumna (patrz poniższy zrzut ekranu), a nazwy są wprowadzane losowo. Może najpierw możesz je posortować, a następnie skopiować i wkleić jeden po drugim do innych nowych arkuszy. Jednak wielokrotne kopiowanie i wklejanie będzie wymagało cierpliwości. Dzisiaj opowiem o kilku szybkich sztuczkach, aby rozwiązać to zadanie.

dokument podziel dane według kolumn 1

Podziel dane na wiele arkuszy roboczych na podstawie kolumny z kodem VBA

Podziel dane na wiele arkuszy roboczych na podstawie kolumny z Kutools for Excel


Podziel dane na wiele arkuszy roboczych na podstawie kolumny z kodem VBA

Jeśli chcesz szybko i automatycznie podzielić dane na podstawie wartości kolumny, poniższy kod VBA jest dobrym wyborem. Zrób tak:

1. Przytrzymaj ALT + F11 klawisze, aby otworzyć Microsoft Visual Basic for Applications okno.

2, Kliknij wstawka > Modułi wklej następujący kod w oknie modułu.

Sub Splitdatabycol()
'updateby Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3. Następnie naciśnij F5 klucz do uruchomienia kodu i pojawia się okienko zachęty przypominające o wybraniu wiersza nagłówka, patrz zrzut ekranu:

dokument podziel dane według kolumn 7

4. A następnie kliknij OK przycisk, aw drugim polu zachęty wybierz dane kolumny, na podstawie których chcesz podzielić, patrz zrzut ekranu:

dokument podziel dane według kolumn 8

5. Następnie kliknij OK, a wszystkie dane w aktywnym arkuszu są podzielone na wiele arkuszy według wartości kolumny. A podzielone arkusze są nazywane z nazwami podzielonych komórek. Zobacz zrzut ekranu:

dokument podziel dane według kolumn 2

Uwagi: Podzielone arkusze są umieszczane na końcu skoroszytu, w którym znajduje się główny arkusz roboczy.


Podziel dane na wiele arkuszy roboczych na podstawie kolumny z Kutools for Excel

Jako początkujący w Excelu ten długi kod VBA jest dla nas nieco trudny, a większość z nas nawet nie wie, jak zmodyfikować kod zgodnie z naszymi potrzebami. Tutaj przedstawię Ci wielofunkcyjne narzędzie -Kutools dla programu Excel, jego Podziel dane Narzędzie nie tylko może pomóc w podzieleniu danych na wiele arkuszy roboczych na podstawie kolumny, ale także może podzielić dane według liczby wierszy.

Uwaga:Aby to zastosować Podziel dane, po pierwsze, należy pobrać plik Kutools dla programu Excel, a następnie szybko i łatwo zastosuj tę funkcję.

Po zainstalowaniu Kutools dla programu Excel, zrób tak:

1. Wybierz zakres danych, które chcesz podzielić.

2, Kliknij Kutools Plus > Ćwiczenie > Podziel danezobacz zrzut ekranu:

dokument podziel dane według kolumn 3

3, w Podziel dane na wiele arkuszy roboczych w oknie dialogowym, musisz:

1). Wybierz Konkretna kolumna opcja w Podziel na podstawie i wybierz wartość kolumny, na podstawie której chcesz podzielić dane, z listy rozwijanej. (Jeśli Twoje dane mają nagłówki i chcesz je wstawiać do każdego nowego podzielonego arkusza, zaznacz Moje dane mają nagłówki opcja.)

2). Następnie możesz określić nazwy podzielonych arkuszy roboczych w obszarze Nowa nazwa arkusza sekcji, określ reguły nazw arkuszy z Zasady rozwijanej listy, możesz dodać Prefiks or Przyrostek również dla nazw arkuszy.

3). Kliknij OK przycisk. Zobacz zrzut ekranu:

dokument podziel dane według kolumn 4

4. Teraz dane są podzielone na wiele arkuszy w nowym skoroszycie.

dokument podziel dane według kolumn 5

Kliknij, aby pobrać Kutools dla programu Excel i bezpłatną wersję próbną teraz!


Podziel dane na wiele arkuszy roboczych na podstawie kolumny z Kutools for Excel

Kutools dla programu Excel zawiera ponad 300 przydatnych narzędzi programu Excel. Bezpłatne wypróbowanie bez ograniczeń w ciągu 30 dni. Pobierz bezpłatną wersję próbną już teraz!


Podobne artykuły:

Jak podzielić dane na wiele arkuszy według liczby wierszy?


Najlepsze narzędzia biurowe

Kutools for Excel rozwiązuje większość twoich problemów i zwiększa wydajność o 80%

  • Ponowne użycie: Szybko włóż złożone wzory, wykresy i wszystko, czego używałeś wcześniej; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny bez utraty danych; Podziel zawartość komórek; Połącz zduplikowane wiersze / kolumny... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Ponad 300 zaawansowanych funkcji. Obsługuje Office / Excel 2007-2019 i 365. Obsługuje wszystkie języki. Łatwe wdrażanie w przedsiębiorstwie lub organizacji. Pełne funkcje 30-dniowy bezpłatny okres próbny. 60-dniowa gwarancja zwrotu pieniędzy.
karta kte 201905

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i zmniejsza setki kliknięć myszą każdego dnia!
officetab dół
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.
    Nilesh · 8 days ago
    Thank you so much.
  • To post as a guest, your comment is unpublished.
    Tom · 21 days ago
    The Kutools split function does not work. 
    I have a file with over 10 million cells (180 000 rows adn 63 columns). I am trying to split the data into 12 sheets based on name in one column. 
    Does the Kutool have a limitation on the number of cells it can split? 
  • To post as a guest, your comment is unpublished.
    Tom · 21 days ago
    The Kutools split function does not work. 
    I have a file with over 10million cells (180 000 rows and 63 columns). I am trying to split them into 12 sheet based on name in one column. 
    Does the Kutool have a limitation on the number of cells it can split? 
  • To post as a guest, your comment is unpublished.
    Ashley Abston · 3 months ago
    Does this VBA code not work if there are other characters like -, () are in the column that we want to split? If not, how can I update the code to control for that?
  • To post as a guest, your comment is unpublished.
    ciot · 6 months ago
    hi,I 've to do un upgrade in this code. More specific, i have a Dataset("Data") to split in multiple sheet and this code it's good to me. But in my new sheet i don't want all column from the orignal data but only specific column. How can i do?
  • To post as a guest, your comment is unpublished.
    Vanessa · 7 months ago
    Hi there, is there a limit on the number of rows in the worksheet you need to split? 

    I have 150,000 rows, that need to be split into diff worksheets based on name of company - this VBA is not working
    • To post as a guest, your comment is unpublished.
      poorna · 1 months ago
      Just make integer to long macros will work fine
    • To post as a guest, your comment is unpublished.
      skyyang · 6 months ago
      Hello, Vanessa,
      If you have tens of thousands rows data need to be split, I will recommend you to use the Kutools for Excel's Split Data feature, with this feature, you can achieve the job quickly and easily. You can download and free trail 30 days. Please try, thank you!
  • To post as a guest, your comment is unpublished.
    Courtney · 7 months ago
    Is there anyway to do this in a way that will maintain the page layout/print set up? header, footer, gridlines, repeat rows, lanscape, narrow margins, fit columns on page, etc?  

  • To post as a guest, your comment is unpublished.
    MIke Merker · 8 months ago
    Just used this today and the VB Script was exactly what I needed.  Thank you!
  • To post as a guest, your comment is unpublished.
    Alberto · 10 months ago
    Hello, I could split the data base! thanks! :)
    But is there any option to keep transferred datas to each excel sheet, if the master sheet is updating daily?
  • To post as a guest, your comment is unpublished.
    Uros D. · 11 months ago
    Hi, question, is there a good way to ONLY bring in certain columns to the split sheets, instead of all?
  • To post as a guest, your comment is unpublished.
    Jesse · 11 months ago
    Dude this is brilliant....saved me many hours of work. Thank you.
  • To post as a guest, your comment is unpublished.
    JD · 11 months ago
    Nothing happens. I run the code, it prompts me for the header & column info, I input it, and then nothing. Not even an error to point me in the right direction.
    • To post as a guest, your comment is unpublished.
      EG · 11 months ago
      I'm running into the same issue.
  • To post as a guest, your comment is unpublished.
    Pratik Trivedi · 1 years ago
    Hi Team,

    Thank you so much for this code it has helped me over the last few months amazingly.

    However, since last month this code has not working for me. It only creates sheets with the name but data, format as well as headers are not carrying over.

    I have changed my computer though not sure if this has to do something with it. I have been using the same code and steps as specified above.

    Please help!

    Thank You!
  • To post as a guest, your comment is unpublished.
    Dom27 · 1 years ago
    Hello.

    I Have problem with borders. In each new table the bottom border is missing.
    Have you got some solution please?
  • To post as a guest, your comment is unpublished.
    soo.kim · 1 years ago
    How can I change to have it paste starting at cell a10 instead of a1 on the new sheets?
  • To post as a guest, your comment is unpublished.
    Jaco van der Merwe · 1 years ago
    Hi there,
    Thank you so much for this post. It is really very helpful.

    I have another situation that requires me to split salary data per department so that each manager will receive a workbook for their team only. I do not mail these out to managers, I simply safe it in their respective folder on the server.

    I use this code, but this code does not split the worksheet into separate files. Can you please help me to modify this code so that it will create separate workbooks for me in the same directory as the master sheet?

    Sub SplitIntoSheets()
    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With
    ThisWorkbook.Activate
    Sheet1.Activate
    'clearing filter if any
    On Error Resume Next
    Sheet1.ShowAllData
    On Error GoTo 0
    Dim lsrClm As Long
    Dim lstRow As Long
    'counting last used row
    lstRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim Planners As Range
    Dim clm As String, clmNo As Long
    On Error GoTo handler
    clm = Application.InputBox("From which column you want create files" & vbCrLf & "E.g. A,B,C,AB,ZA etc.")
    clmNo = Range(clm & "1").Column
    Set Planners = Range(clm & "2:" & clm & lstRow)
    'Calling Remove Duplicates to Get Unique Names
    Set Planners = RemoveDuplicates(Planners)
    Call CreateSheets(Planners, clmNo)
    With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .AlertBeforeOverwriting = True
    .Calculation = xlCalculationAutomatic
    End With
    Sheet1.Activate
    MsgBox "Well Done!"
    Exit Sub
    Data.ShowAllData
    handler:
    With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .AlertBeforeOverwriting = True
    .Calculation = xlCalculationAutomatic
    End With
    End Sub
    Function RemoveDuplicates(Planners As Range) As Range
    ThisWorkbook.Activate
    Sheets.Add
    On Error Resume Next
    ActiveSheet.Name = "Planners"
    Sheets("Planners").Activate
    On Error GoTo 0
    Planners.Copy
    Cells(2, 1).Activate
    ActiveCell.PasteSpecial xlPasteValues
    Range("A1").Value = "Planners"
    Dim lstRow As Long
    lstRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A2:A" & lstRow).Select
    ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns:=1, Header:=xlNo
    lstRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set RemoveDuplicates = Range("A2:A" & lstRow)
    End Function
    Sub CreateSheets(Planners As Range, clmNo As Long)
    Dim lstClm As Long
    Dim lstRow As Long

    For Each Unique In Planners
    Sheet1.Activate
    lstRow = Cells(Rows.Count, 1).End(xlUp).Row
    lstClm = Cells(1, Columns.Count).End(xlToLeft).Column
    Dim dataSet As Range
    Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm))
    dataSet.AutoFilter field:=clmNo, Criteria1:=Unique.Value
    lstRow = Cells(Rows.Count, 1).End(xlUp).Row
    lstClm = Cells(1, Columns.Count).End(xlToLeft).Column
    Debug.Print lstRow; lstClm
    Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm))
    dataSet.Copy
    Sheets.Add
    ActiveSheet.Name = Unique.Value2
    ActiveCell.PasteSpecial xlPasteAll
    Next Unique
    End Sub
    • To post as a guest, your comment is unpublished.
      skyyang · 1 years ago
      Hello, Jaco,
      To split the data into multiple separate workbooks based on the column value, the code in the following article may help you:
      https://www.datanumen.com/blogs/2-fast-means-to-split-an-excel-worksheets-contents-into-multiple-workbooks-based-on-a-specific-column/

      Please try it, thank you!
  • To post as a guest, your comment is unpublished.
    Ani · 1 years ago
    Hi, it is working great but I need to keep the header row and the infromation above it in each sheet and also the formatting of the header row.
    Does anyone know how this can happen?


  • To post as a guest, your comment is unpublished.
    Joe · 1 years ago
    This is awesome!! Thank you so much for sharing!
  • To post as a guest, your comment is unpublished.
    Kevin · 1 years ago
    Hey, i really need some help.
    1. first i want to to split based on value and after that to split per 1k based on value before.
    2. After split per 1k, i need to save as those files to xls.

    Can someone help me to solve thats problem
  • To post as a guest, your comment is unpublished.
    nk · 1 years ago
    This macro has come in handy more times than i can count, Does anyone have a work around for these two issues? Any help is appreciated!

    1. make the Macro work form a worksheet that is formatted as a table and maintain the same formatting in the new worksheets? I have been able to use this macro when the worksheet is not formatted.

    2. split columns that Include blank cells from the original worksheet to the new worksheets. My original data has some empty cells, that need to remain empty, when i use this macro, the divided columns exclude the data that had an empty cell in the column that was split.
  • To post as a guest, your comment is unpublished.
    NK · 1 years ago
    This macro has come in handy more times than i can count, Does anyone have a work around for these two issues? Any help is appreciated!

    1. make the Macro work form a worksheet that is formatted as a table and maintain the same formatting in the new worksheets? I have been able to use this macro when the worksheet is not formatted.

    2. split columns that Include blank cells from the original worksheet to the new worksheets. My original data has some empty cells, that need to remain empty, when i use this macro, the divided columns exclude the data that had an empty cell in the column that was split.
  • To post as a guest, your comment is unpublished.
    AshSam123 · 1 years ago
    Hey everyone. I am completely new to VBA. I have an account receivable data in an excel sheet and there are multiple column. One column mention the invoice no and the other mentions the department responsible for that invoice. I have tried this code, it split the column by department into multiple sheets but it does not include the invoice no. I have a big list of data and I don't to want copy and paste the data, can someone please help me. Thanks
    • To post as a guest, your comment is unpublished.
      AshSam123 · 1 years ago
      Thank you for your response. I cannot post the original, but here is the sample data. I hope you can help me. Many Thanks
    • To post as a guest, your comment is unpublished.
      skyyang · 1 years ago
      Hi, Ayesha,
      Could you upload your problem screenshot here? Thank you!
  • To post as a guest, your comment is unpublished.
    Guest25 · 1 years ago
    The vba code is not working if the column values to split on has a length of 26. If I manually change it to 12 it works. Is there a reason for it. I understand that excel worksheet name cannot exceed 30 characters but here the length is 26 but it does not work. Can you please help me understand this. Thanks.
    • To post as a guest, your comment is unpublished.
      skyyang · 1 years ago
      Hello,
      Thank you for your comment, yes, as you said, the above vba code is not worked correctlly for cell values which text length are much longer, but, here, you can apply our product, Kutools for Excel, with its Split Data feature, you can achieve this job quickly and easily. You can download and free trail 30 days. Please try, thank you!
  • To post as a guest, your comment is unpublished.
    Melvin · 2 years ago
    the code to split the data works perfectly, except it skips some data and renames these as "sheet#"
  • To post as a guest, your comment is unpublished.
    sha · 2 years ago
    thank you very much, it helped me a lot in my work. However, is there a way to have the macro create a separate spreadsheet for each new tab instead of just adding a tab into the current worksheet? Thanks!
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      Hi,
      If you want to save each sheet as a new workbbok based on the column value, the following articles may help you! Please check:

      https://www.extendoffice.com/documents/excel/2734-excel-split-data-into-multiple-workbooks.html
      https://www.datanumen.com/blogs/2-fast-means-to-split-an-excel-worksheets-contents-into-multiple-workbooks-based-on-a-specific-column/
  • To post as a guest, your comment is unpublished.
    G · 2 years ago
    How can I make it to automatically choose a smaller name for the sheet instead of skipping an entry and returning sheet 4, sheet 5 etc.

    E.G: I am using this amazing code to dissect my excel sheet, but some entries have a long name which exceeds the sheet name count, instead of using all 31 symbols that are allowed, it cancels the filtering and returns sheet 4 instead.
  • To post as a guest, your comment is unpublished.
    K · 2 years ago
    Could I make it so that I would be able to automatically split it so both Emily and Lucy's are in one page, and Jone and Steven's are in another?
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      Hi,
      Sorry, at present, maybe there is not a good method for solving your problem. But you can combine the two sheets you need after splitting.
  • To post as a guest, your comment is unpublished.
    Mark · 2 years ago
    This works great but is there a way I can carry over my formulas from the original worksheet?
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      Hi, Mark,
      The above VBA code helps to keep the formula cells after splitting the data, please try!
      Thank you!
      • To post as a guest, your comment is unpublished.
        Mark · 2 years ago
        Works great!


        Thanks for all your help!
  • To post as a guest, your comment is unpublished.
    Bernhard · 2 years ago
    Thank you, worked excellently!
  • To post as a guest, your comment is unpublished.
    Degardt · 2 years ago
    This code is brilliant. It does exactly what I need. Only, I don't know how to change the code so that the data in the rows, all starting with the same letter, should go on the same worksheet, instead of each getting its own worksheet. I have 1000 rows of data, some starting with "L", or "K"or "F" and then a number. It sorts the data each to its own sheet, I want all the "L" cells' data on one sheet and all the"K" data on one sheet. Can someone please help me. I don't underwstand coding that good
    • To post as a guest, your comment is unpublished.
      MP · 2 years ago
      Add a column and pull the first character from the cell with L+ the number or K+ the number. Assume your key is in cell A2, use the formula =left(A2,1) to pull the first character into your new column. Use this column to separate data to its own sheet.
      • To post as a guest, your comment is unpublished.
        Degardt · 2 years ago
        Thank you MP, I will definitely try that. I'm new to coding and still trying to figure it out as I go. But it's crunch time and i need the program to work ASAP. For now I'm just struggling a bit. Lol
  • To post as a guest, your comment is unpublished.
    Aaron · 2 years ago
    Why does the VBA create new sheets with columns all the way to XFD when my main sheet only goes to AK?
  • To post as a guest, your comment is unpublished.
    ShiroKuro · 2 years ago
    how do i make this work on around 150k rows count. Thanks
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      Hello, ShiroKuro,
      If there are large data in your worksheet, I recommend Kutools for Excel's Split Data feature for you, you can download it and free trial 60-day!
      Please try, thank you!
  • To post as a guest, your comment is unpublished.
    adityabhatnagar2103@gmail.com · 2 years ago
    Great script! Could someone please help as I need to just add "Class-C" at the end of each new worksheet's name that is created after running this. For Eg. Lucy-Class C; Emily Class C; and so on. Would really appreciate your help here.
    • To post as a guest, your comment is unpublished.
      Me · 2 years ago
      just add a column and concatenate the Name and the "-Class C" field and use that as the column to split on instead of the Name column, then you can hide the column if you want
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      Hello, Aditya,
      Here, I recommend Kutools for Excel's Split Data feature for you, you can add the prefix or suffix text easily in the dialog box as you need.
      You can download the tool and free trial 60-day.
      Please try, thank you!
  • To post as a guest, your comment is unpublished.
    Katharina · 2 years ago
    Great Script, thanks! What do I have to do to set the header row range and column to use for grouping/splitting within the script? I know it is more elegant to use selectable parameters but for my use case it is always the same. As I do know nothing about VBA, any little hint is appreciated :-) Best, Katharina
  • To post as a guest, your comment is unpublished.
    daiana · 2 years ago
    It doesn't work with 120000 rows. Is there any way to make it work?
  • To post as a guest, your comment is unpublished.
    Radoslav · 2 years ago
    Perfect!!! Works and refer to all my demands. Tnx for that source code.
  • To post as a guest, your comment is unpublished.
    Rudi Miller · 2 years ago
    Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 1
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:C1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
  • To post as a guest, your comment is unpublished.
    Jason · 3 years ago
    This formula is great, works perfectly for me.
    I want to split out data based on a location, which is in column 1. Which this does.
    However, is it possible to also split out based on column 2, for example. Built and Not Built. So a secondary condition also?
  • To post as a guest, your comment is unpublished.
    jose · 3 years ago
    can someone help please im using this but i keep getting to many columns. i have to keep deleting rows every time i use this.

    This is what im using


    Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 1
    Set ws = Sheets("sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:AN1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
  • To post as a guest, your comment is unpublished.
    itsavinash · 3 years ago
    Thanks for VBA, it works great. In addition to that question, I have column which is dependent. So when i select some value my column values get changed hence I need vba solution to replace earlier split worksheet to replace with new value of columns. Can anyone help me out.?

    Thanks in advance
  • To post as a guest, your comment is unpublished.
    JP Tontegode · 3 years ago
    Is there a way to have the macro create a separate spreadsheet for each new tab instead of just adding a tab into the current worksheet? Thanks!
  • To post as a guest, your comment is unpublished.
    Sebastian · 3 years ago
    Effectively, this code does work great. I wrote an additional code so that I could get subtotal on certain columns but it has not worked great. So I tried running the subtotals from the master list, but afterwards when I use this macro it create a whole new tab for the Grand total row. So I am getting two two tabs per split. the first one is fine because it splits with the grand totals, but then creates a second one with just the grand total row. Any help as to how to modify this.
    This is the code that I am currently using:
    Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 3
    Set ws = Sheets("Master sheet")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:R1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
  • To post as a guest, your comment is unpublished.
    Jenny Singleton · 3 years ago
    Hi, This VBA worked great on my first attempt. However, when repeating the process with a new set of data, the sheets are splitting into Product names, but the data in each sheet still shows all data. I can't understand why it worked first time though. Can anyone help please. Thanks
  • To post as a guest, your comment is unpublished.
    Trisha · 3 years ago
    This code is brilliant - Thank you. Just one thing - its splitting the data as I need it too but amongst creating the relevant sheets its creating blank sheets too.


    Are you able to help with this?
  • To post as a guest, your comment is unpublished.
    aaseef.khan@gmail.com · 3 years ago
    Thanks for the Magic Words
  • To post as a guest, your comment is unpublished.
    Muhammad Jahanzaib · 3 years ago
    Thanks for excellent & brilliant code. I came across a bug, if field name is too long, the new sheet is not created. It should be like that the new sheet may be named with the maximum number of characters allowed. Regards,
  • To post as a guest, your comment is unpublished.
    Alex S · 3 years ago
    To anyone having issues with long sheet names (ie Sheet Names greater than 30 characters), replace:

    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next

    with

    Dim sheetName As String
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    ' Replace the below assignment to sheetName as you wish
    sheetName = Left(CStr(i - 1) & "_" & myarr(i), 30)
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = sheetName
    Else
    Sheets(sheetName).Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(sheetName).Range("A1")
    Sheets(sheetName).Columns.AutoFit
    Next

    This essentially limits the Sheet Name to legal limits of 30 characters. If you do not like the way the sheet is named, replace sheetName's assignment whatever you would like, keeping in mind that no two sheets can have the exact same name and must also be 30 characters or less.

    You can also remove the filtering that lingers at the end of the execution by adding this line just before "End Sub"

    On Error Resume Next
    ActiveSheet.ShowAllData

    Enjoy ^_^
  • To post as a guest, your comment is unpublished.
    prdpsharma90@gmail.com · 3 years ago
    I have used this VBA code, its split the data but split whole data in new sheet instead of unique value.
  • To post as a guest, your comment is unpublished.
    Pradeep Sharma · 3 years ago
    The VBA code split the data perfectly but its split the whole data instead of unique value.