Ugrás a tartalomra

Excel-tippek: Oszd fel az adatokat több munkalapra/munkafüzetre az oszlopérték alapján

When managing large datasets in Excel, it can be highly beneficial to split data into multiple worksheets based on specific column values. This method improves not only the organization of data but also enhances readability and facilitates easier data analysis.

Suppose you have a large sales record containing multiple entries such as the product name, the quantity sold of the first quarter. The goal is to split this data into separate worksheets based on each product name so that individual sales performance can be analyzed separately.

Split data into multiple worksheets based on column value

Split data into multiple workbooks based on column value with VBA code


Split data into multiple worksheets based on column value

Normally, you can sort the data list first, and then copy and paste them one by one into other new worksheets. But this will need your patience to copy and paste repeatedly. In this section, we will introduce two straightforward methods to efficiently tackle this task in Excel, saving you time and reducing the potential for errors.

Split data into multiple worksheets based on column value with VBA code

1. Tartsa lenyomva a ALT + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. kettyenés betétlap > Modulok, és illessze be a következő kódot a Modul ablakba.

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
Dim xWS 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
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.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. Ezután nyomja meg a gombot F5 key to run the code, and a prompt box is popped out to remind you select the header row, and then, click OK. Lásd a képernyőképet:

4. In the second prompt box, please select the column data that you want to split based on, then, click OK. Lásd a képernyőképet:

5. All data in the active worksheet is divided into multiple worksheets based on the column values. The resulting worksheets are named according to the values in the split cells and are placed at the end of the workbook. See screenshot:

 

Split data into multiple worksheets based on column value with Kutools for Excel

Kutools az Excel számára brings smart feature – Osztott adatok right into your Excel environment. Splitting data into multiple worksheets is no longer a challenge. Our intuitive tool automatically divides your dataset based on the chosen column value or rows count, ensuring that each piece of information is exactly where you need it. Say goodbye to the tedious task of manually organizing your spreadsheets and embrace a faster, error-free way to manage your data.

Megjegyzések: Ennek alkalmazásához Osztott adatok, először is le kell töltenie a Kutools az Excel számára, majd gyorsan és egyszerűen alkalmazza a funkciót.

Telepítése után Kutools az Excel számára, válassza ki az adattartományt, majd kattintson a gombra Kutools Plus > Osztott adatok megnyitni Split Data into multiple worksheets párbeszédablak.

  1. választ Konkrét oszlop lehetőség a Felosztása alapján section, and choose the column value which you want to split the data based on from the drop-down list.
  2. Ha az adatoknak vannak fejlécek, és minden egyes új felosztott munkalapba szeretné beilleszteni őket, ellenőrizze Adataim fejléceket tartalmaznak option. (You can specify the number of header rows based on your data. For example, if your data contains two headers, please type 2.)
  3. Ezután megadhatja az osztott munkalap nevét a Új munkalapok neve section, specify the worksheet names rule from the Rules drop down list, you can add the prefix or képző a lapnevekhez is.
  4. Kattintson az OK gomb. Lásd a képernyőképet:

Now, the data in the worksheet is split into multiple worksheets in a new workbook.


Split data into multiple workbooks based on column value with VBA code

Occasionally, rather than dividing data into multiple worksheets, it may be more beneficial to split the data into separate workbooks based on a key column. Here's a step-by-step guide on how to use VBA code to automate the process of splitting data into multiple workbooks based on a specific column value.

1. Tartsa lenyomva a ALT + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. kettyenés betétlap > Modulok, és illessze be a következő kódot a Modul ablak.

Sub SplitDataByColToWorkbooks()
    ' Updateby Extendoffice
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim xTRg As Range
    Dim xVRg As Range
    Dim xWS As Workbook
    Dim savePath As String
    ' Set the directory to save new workbooks
    savePath = "C:\Users\AddinsVM001\Desktop\multiple files\" ' Modify this path as needed
    Application.DisplayAlerts = False
    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.Address(False, False)
    titlerow = xTRg.Row
    ws.Columns(vcol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, ws.Columns.Count), Unique:=True
    myarr = Application.Transpose(ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).Value)
    ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).ClearContents
    For i = 2 To UBound(myarr)
        Set xWS = Workbooks.Add
        ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i)
        ws.Range("A" & titlerow & ":A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        xWS.Sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteAll
        xWS.SaveAs Filename:=savePath & myarr(i) & ".xlsx"

        xWS.Close SaveChanges:=False
    Next i
    ws.AutoFilterMode = False
    Application.DisplayAlerts = True
    ws.Activate
End Sub
Megjegyzések: In the above code, you should change the file path to your own where will save the split workbooks in this script: savePath = "C:\Users\AddinsVM001\Desktop\multiple files\".

3. Ezután nyomja meg a gombot F5 key to run the code, and a prompt box is popped out to remind you select the header row, and then, click OK. Lásd a képernyőképet:

4. In the second prompt box, please select the column data that you want to split based on, then, click OK. Lásd a képernyőképet:

5. After splitting, all data in the active worksheet is divided into multiple workbooks based on the column values. All the split workbooks are saved into the folder you specified. See screenshot:

Kapcsolódó cikkek:

  • Az adatok felosztása több munkalapra sorszám szerint
  • Egy nagy adattartomány hatékony felosztása több Excel munkalapra egy adott sorszám alapján egyszerűsítheti az adatkezelést. Például, ha egy adatkészletet 5 soronként több lapra oszt fel, kezelhetőbbé és szervezettebbé teheti azt. Ez az útmutató két gyakorlati módszert kínál ennek a feladatnak a gyors és egyszerű elvégzésére.
  • Egyesítsen két vagy több táblázatot egybe a kulcsoszlopok alapján
  • Ha feltételezzük, hogy három táblázata van egy munkafüzetben, akkor ezeket a táblázatokat egy táblába kívánja egyesíteni a megfelelő kulcsoszlopok alapján, hogy az eredményt az alábbi képernyőképen láthatja. Ez a legtöbbünk számára problémás feladat lehet, de, ne aggódjon, ez a cikk bemutat néhány módszert a probléma megoldására.
  • Split Text Strings by Delimiter into Multiple Rows
  • Általában a Szöveg oszlopba funkciót használhatja a cellák tartalmának több oszlopra történő felosztására egy adott határolóval, például vesszővel, ponttal, pontosvesszővel, perjellel stb. De előfordulhat, hogy a határolt cellatartalmat több sorra kell felosztania. és ismételje meg a többi oszlopból származó adatokat az alábbi képernyőképen látható módon. Van valami jó módja ennek a feladatnak az Excelben való kezelésére? Ez az oktatóanyag bemutat néhány hatékony módszert ennek a feladatnak az Excelben való elvégzéséhez.
  • Split multiline cell contents into separated rows/columns
  • Tegyük fel, hogy többsoros cellatartalma van, amelyet Alt + Enter választ el, és most szét kell osztania a többsoros tartalmat elválasztott sorokra vagy oszlopokra, mit tehet? Ebből a cikkből megtudhatja, hogyan lehet gyorsan felosztani a többsoros cellatartalmat külön sorokra vagy oszlopokra.

A legjobb irodai hatékonyságnövelő eszközök

🤖 Kutools AI Aide: Forradalmasítsa az adatelemzést a következők alapján: Intelligens végrehajtás   |  Kód létrehozása  |  Hozzon létre egyéni képleteket  |  Adatok elemzése és diagramok létrehozása  |  A Kutools funkciók meghívása...
Népszerű szolgáltatások: Ismétlődések keresése, kiemelése vagy azonosítása   |  Üres sorok törlése   |  Oszlopok vagy cellák kombinálása adatvesztés nélkül   |   Kerek Formula nélkül ...
Szuper keresés: Több kritérium VLookup    Többértékű VLookup  |   VLookup több munkalapon   |   Fuzzy Lookup ....
Speciális legördülő lista: Gyors legördülő lista létrehozása   |  Függő legördülő lista   |  Többszörösen válassza ki a legördülő listát ....
Oszlopkezelő: Adjon meg egy adott számú oszlopot  |  Oszlopok mozgatása  |  Kapcsolja be a Rejtett oszlopok láthatósági állapotát  |  Tartományok és oszlopok összehasonlítása ...
Kiemelt funkciók: Rács fókusz   |  Design nézet   |   Nagy Formula bár    Munkafüzet és lapkezelő   |  Erőforrás-könyvtár (Auto szöveg)   |  Dátumválasztó   |  Kombinálja a munkalapokat   |  Cellák titkosítása/dekódolása    E-mailek küldése listánként   |  Szuper szűrő   |   Speciális szűrő (félkövér/dőlt/áthúzott szűrés...) ...
A 15 legjobb eszközkészlet12 szöveg Eszközök (Szöveg hozzáadása, Karakterek eltávolítása,...)   |   50 + Táblázatos Típusai (Gantt-diagram,...)   |   40+ Praktikus képletek (Számolja ki az életkort a születésnap alapján,...)   |   19 beszúrás Eszközök (Helyezze be a QR-kódot, Kép beszúrása az útvonalból,...)   |   12 Átalakítás Eszközök (Számok szavakig, Valuta átváltás,...)   |   7 Egyesítés és felosztás Eszközök (Haladó kombinált sorok, Hasított sejtek,...)   |   ... és több

Töltsd fel Excel-készségeidet a Kutools for Excel segítségével, és tapasztald meg a még soha nem látott hatékonyságot. A Kutools for Excel több mint 300 speciális funkciót kínál a termelékenység fokozásához és az időmegtakarításhoz.  Kattintson ide, hogy megszerezze a leginkább szükséges funkciót...

Leírás


Az Office lap füles felületet hoz az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
Comments (312)
Rated 5 out of 5 · 2 ratings
This comment was minimized by the moderator on the site
Sub SplitDataByColWorkbook()
Dim lr As Long
Dim ws As Worksheet
Dim vcol 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
Dim xWS As Workbook
Dim wb As Workbook


Set wb = ThisWorkbook
Set ws = wb.Sheets(1) ' Assuming you want to work with the first sheet in the workbook

On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Select Header Rows", Type:=8)
If xTRg Is Nothing Then Exit Sub

On Error Resume Next
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Select Split Column", Type:=8)
If xVRg Is Nothing Then Exit Sub

vcol = xVRg.Column
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
Set xWS = Workbooks.Add
Else
Set xWS = Workbooks.Add
End If

Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
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) & ""
Set xWS = Workbooks.Add
Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWSTRg.Range("A" & (titlerow + xTRg.Rows.Count))
xWSTRg.Columns.AutoFit
xWS.SaveAs myarr(i) & ".xlsx" ' Change the file name as needed
xWS.Close SaveChanges:=False
Next

ws.AutoFilterMode = False
wb.Activate
Application.DisplayAlerts = True
End Sub
This comment was minimized by the moderator on the site
First of all, thank you for the macro.

I would like to ask if there is any way to maintain the column widths. My 'original' tab was completely formatted. However, after running the macro, it loses the column formatting and appears quite messy.

English is not my first language (sorry).

Thank you again!
Rated 5 out of 5
This comment was minimized by the moderator on the site
The original header is not copied in the split sheet.
This comment was minimized by the moderator on the site
This works wonderfully, thank you very much!!! Huge time-saver.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Hello,

I am having a hard time getting this code to work. When I run it, it just creates a duplicate sheet and does not split columns into multiple sheets.

I do have values that exceed 31 characters as well as special characters such as "-" and "()" in my column, how can I account for that without a lot of manual changes?
This comment was minimized by the moderator on the site
This worked great!!! One question... my formulas didn't transfer to each sheet correctly. What do I need to do differently to transfer the formulas?
Thank you!!!!!
This comment was minimized by the moderator on the site
Nice code, but it just copied everything to the new tables, named correctly though. So, the data filtering did not work at all, just copy paste.
This comment was minimized by the moderator on the site
When I run this using a small amount of data like the example it works. I'm trying to use this on a database with 400k + rows of data. When I run the macro, a second tab is created with just the header row and no data.
This comment was minimized by the moderator on the site
Hello, Ryan,

As you mentioned, the code works well for small data ranges, if there are lots of data, the code will not work properly.
In such situations, I recommend using the "Split Data" feature offered by Kutools for Excel. This powerful feature can greatly assist you in managing large amounts of data. To take advantage of this feature, you can download and install Kutools for Excel, which is available for a 30-day free trial.

Please have a try, thank you!
This comment was minimized by the moderator on the site
I've come across many solutions in VBA message boards for parsing data into worksheets or columns based upon filtering a particular column, but they all require a bit of tinkering and customization. What makes this so brilliant is that it is dynamic, user-friendly even for beginners (which gives it shareable utility), and copy/paste ready.

You rock.
This comment was minimized by the moderator on the site
Hi, Dane,
Thanks for your comment, glad this can help you! Have a good day!
This comment was minimized by the moderator on the site
When I try to split data from a different sheet, it copies and pastes the entire sheet into one sheet instead of multiple sheets. Could this be because the naming convention of the sheet I'm trying to split is similar to another sheet?
This comment was minimized by the moderator on the site
Hello, Giancarlo,

If the data in the column is same with a sheet name in the workbook, the sheet with the same name will be kept, other data will be split into separate sheet.
Thanks for your comment.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations