Loncat ke daftar isi utama

Bagaimana cara membagi data menjadi beberapa lembar kerja berdasarkan kolom di Excel?

Misalkan Anda memiliki lembar kerja dengan banyak baris data, dan sekarang, Anda perlu membagi data menjadi beberapa lembar kerja berdasarkan Nama kolom (lihat tangkapan layar berikut), dan nama-nama dimasukkan secara acak. Mungkin Anda dapat mengurutkannya terlebih dahulu, lalu menyalin dan menempelkannya satu per satu ke lembar kerja baru lainnya. Namun hal ini membutuhkan kesabaran Anda untuk melakukan copy paste berulang kali. Hari ini, saya akan berbicara tentang beberapa trik cepat untuk menyelesaikan tugas ini.

doc membagi data dengan kolom 1

Pisahkan data menjadi beberapa lembar kerja berdasarkan kolom dengan kode VBA

Bagi data menjadi beberapa lembar kerja berdasarkan kolom dengan Kutools for Excel


Pisahkan data menjadi beberapa lembar kerja berdasarkan kolom dengan kode VBA

Jika Anda ingin membagi data berdasarkan nilai kolom dengan cepat dan otomatis, kode VBA berikut adalah pilihan yang baik. Harap lakukan seperti ini:

1. Tahan ALT + F11 kunci untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Klik Menyisipkan > Modul, dan tempel kode berikut di Module Window.

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. Lalu tekan F5 kunci untuk menjalankan kode, dan kotak prompt muncul untuk mengingatkan Anda memilih baris header, lihat tangkapan layar:

doc membagi data dengan kolom 7

4. Dan kemudian, klik OK tombol, dan di kotak prompt kedua, pilih data kolom yang ingin Anda bagi berdasarkan, lihat tangkapan layar:

doc membagi data dengan kolom 8

5. Lalu klik OK, dan semua data di lembar kerja aktif dipecah menjadi beberapa lembar kerja berdasarkan nilai kolom. Dan lembar kerja yang dipisahkan diberi nama dengan nama sel yang dipisahkan. Lihat tangkapan layar:

doc membagi data dengan kolom 2

Note: Lembar kerja terpisah ditempatkan di akhir buku kerja tempat lembar kerja master berada.


Bagi data menjadi beberapa lembar kerja berdasarkan kolom dengan Kutools for Excel

Sebagai pemula Excel, kode VBA yang panjang ini agak sulit bagi kami, dan kebanyakan dari kami bahkan tidak tahu cara memodifikasi kode sesuai kebutuhan kami. Di sini, saya akan memperkenalkan Anda alat multifungsi--Kutools untuk Excel, nya Data split utilitas tidak hanya dapat membantu Anda untuk membagi data menjadi beberapa lembar kerja berdasarkan kolom, tetapi juga dapat membagi data dengan jumlah baris.

Catatan:Untuk menerapkan ini Data split, pertama, Anda harus mengunduh Kutools untuk Excel, lalu terapkan fitur dengan cepat dan mudah.

Setelah menginstal Kutools untuk Excel, lakukan seperti ini:

1. Pilih rentang data yang ingin Anda pisahkan.

2. Klik Kutools Ditambah > Lembar Kerja > Data split, lihat tangkapan layar:

doc membagi data dengan kolom 3

3. di Pisahkan Data menjadi Beberapa Lembar Kerja kotak dialog, Anda perlu:

1). Pilih Kolom tertentu pilihan dalam Pisahkan berdasarkan bagian, dan pilih nilai kolom yang ingin Anda pisahkan datanya berdasarkan di daftar turun bawah. (Jika data Anda memiliki header dan Anda ingin memasukkannya ke dalam setiap lembar kerja split baru, harap periksa Data saya memiliki tajuk pilihan.)

2). Kemudian Anda dapat menentukan nama lembar kerja terpisah, di bawah Nama lembar kerja baru bagian, tentukan aturan nama lembar kerja dari Peraturan daftar drop-down, Anda dapat menambahkan Awalan or Akhiran untuk nama sheet juga.

3). Klik OK tombol. Lihat tangkapan layar:

doc membagi data dengan kolom 4

4. Sekarang data dipecah menjadi beberapa lembar kerja di buku kerja baru.

doc membagi data dengan kolom 5

Klik untuk Mengunduh Kutools for Excel dan uji coba gratis Sekarang!


Bagi data menjadi beberapa lembar kerja berdasarkan kolom dengan Kutools for Excel

Kutools untuk Excel mencakup lebih dari 300 alat Excel yang praktis. Gratis untuk mencoba tanpa batasan dalam 30 hari. Unduh uji coba gratis sekarang!


Artikel terkait:

Bagaimana cara membagi data menjadi beberapa lembar kerja dengan jumlah baris?

Alat Produktivitas Kantor Terbaik

馃 Kutools AI Ajudan: Merevolusi analisis data berdasarkan: Eksekusi Cerdas   |  Hasilkan Kode  |  Buat Rumus Khusus  |  Analisis Data dan Hasilkan Grafik  |  Aktifkan Fungsi Kutools...
Fitur Populer: Temukan, Sorot, atau Identifikasi Duplikat   |  Hapus Baris Kosong   |  Gabungkan Kolom atau Sel tanpa Kehilangan Data   |   Putaran tanpa Formula ...
Pencarian Super: VLookup Beberapa Kriteria    VLookup Nilai Berganda  |   VLookup di Beberapa Lembar   |   Pencarian Fuzzy ....
Daftar Drop-down Lanjutan: Buat Daftar Drop Down dengan Cepat   |  Daftar Drop Down yang Bergantung   |  Multi-pilih Drop Down List ....
Manajer Kolom: Tambahkan Jumlah Kolom Tertentu  |  Pindahkan Kolom  |  Alihkan Status Visibilitas Kolom Tersembunyi  |  Bandingkan Rentang & Kolom ...
Fitur Unggulan: Fokus Kisi   |  Tampilan Desain   |   Bar Formula Besar    Manajer Buku Kerja & Lembar   |  Perpustakaan Sumberdaya (Teks otomatis)   |  Pemetik tanggal   |  Gabungkan Lembar Kerja   |  Enkripsi/Dekripsi Sel    Kirim Email berdasarkan Daftar   |  Filter Super   |   Filter Khusus (filter tebal/miring/coret...) ...
15 Perangkat Teratas12 Teks Tools (Tambahkan Teks, Hapus Karakter, ...)   |   50 + Grafik jenis (Gantt Chart, ...)   |   40+ Praktis Rumus (Hitung usia berdasarkan ulang tahun, ...)   |   19 Insersi Tools (Masukkan Kode QR, Sisipkan Gambar dari Jalur, ...)   |   12 Konversi Tools (Angka ke Kata, Konversi Mata Uang, ...)   |   7 Gabungkan & Pisahkan Tools (Lanjutan Gabungkan Baris, Pisahkan Sel, ...)   |   ... dan banyak lagi

Tingkatkan Keterampilan Excel Anda dengan Kutools for Excel, dan Rasakan Efisiensi yang Belum Pernah Ada Sebelumnya. Kutools for Excel Menawarkan Lebih dari 300 Fitur Lanjutan untuk Meningkatkan Produktivitas dan Menghemat Waktu.  Klik Di Sini untuk Mendapatkan Fitur yang Paling Anda Butuhkan...

Deskripsi Produk


Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
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