Persiapan yang kita butuhkan:
1. PC yang sudah terinstal Microsoft Office, khususnya microsoft Excel dan sudah di aktivasi, pada tulisan ini, kami praktek menggunakan Ms. Office 2010.
2. File excel yang akan dibagi berdasarkan kategori tertentu, bisa diunduh disini.
3. Kopi satu cangkir (Untuk menghindari Ngantuk).
4. Iman yang kuat (Kalau waktunya Sholat berhenti dulu bro buat sholat - Khusus Muslim).
Selanjutnya akan kita uraikan langkah-langkahnya:
1. Siapkan file excel dengan data yang sudah terkategori, pada praktek ini saya menggunakan data fiktif kumpulan penduduk di suatu kota yang akan kita pecah berdasarkan kategori kelurahan. Untuk praktek silahkan unduh filenya disini.
Gambar 1. Kolom kelurahan yang digunakan sebagai acuan pemecahan kategori.
2. Blok kolom Nama Kelurahan (Kolom F) pindah ke kolom ke (Kolom B). Penting agar tidak keliru, rumus ini saya buat khusus untuk kategori yang di letakkan di Kolom B, jika kita letakkan kategori di kolom selain Kolom B maka pemecahan file tidak akan berhasil. Cara pindah bisa dengan cara Blok (Kolom F) ->> Kemudian Tekan tombol Ctrl+X ->> Blok (Kolom B) -->> Klik Kanan Pilih Muncul (Insert Cut Cell).
Gambar 2. Proses pemindahan kolom kelurahan (Kolom F) Ke (Kolom B).
Gambar 3. Kolom kelurahan berhasil dipindah ke (Kolom B).
3. Tekan tombol ALT+F11 untuk menampilkan editor VBA Macro.
4. Klik satu kali This Workbook->> pilih Insert ->> Module
Gambar 4. Proses menampilkan kolom Module Editor VBA Macro.
5. Copas script VBA Macro Berikut ke dalam editor Module.
Sub SplitSheetDataIntoMultipleWorkbooksBasedOnSpecificColumn()
Dim objWorksheet As Excel.Worksheet
Dim nLastRow, nRow, nNextRow As Integer
Dim strColumnValue As String
Dim objDictionary As Object
Dim varColumnValues As Variant
Dim varColumnValue As Variant
Dim objExcelWorkbook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Set objWorksheet = ActiveSheet
nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row
Set objDictionary = CreateObject("Scripting.Dictionary")
For nRow = 2 To nLastRow
'Pilih kategori khusus
'Disini saya gunakan kolom B
'Gunakan Kolom B dalam kasus lain
strColumnValue = objWorksheet.Range("B" & nRow).Value
If objDictionary.Exists(strColumnValue) = False Then
objDictionary.Add strColumnValue, 1
End If
Next
varColumnValues = objDictionary.Keys
For i = LBound(varColumnValues) To UBound(varColumnValues)
varColumnValue = varColumnValues(i)
'Script buat workbook baru
Set objExcelWorkbook = Excel.Application.Workbooks.Add
Set objSheet = objExcelWorkbook.Sheets(1)
objSheet.Name = objWorksheet.Name
objWorksheet.Rows(1).EntireRow.Copy
objSheet.Activate
objSheet.Range("A1").Select
objSheet.Paste
For nRow = 2 To nLastRow
If CStr(objWorksheet.Range("B" & nRow).Value) = CStr(varColumnValue) Then
'copy data dengan clom B yang sama sebagai nilai kategori
objWorksheet.Rows(nRow).EntireRow.Copy
nNextRow = objSheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1
objSheet.Range("A" & nNextRow).Select
objSheet.Paste
objSheet.Columns("A:B").AutoFit
End If
Next
Next
End Sub
Gambar 5. Copas Script Pecah File di Editor Modul VBA macro.
Gambar 6. Tombol Play.
Gambar 7. Workbook Baru sesuai kategori
9. Selesai.
Demikian tutorial tentang bagaimana cara PECAH FILE EXCEL MENJADI BEBERAPA FILE BERDASARKAN KATEGORI TERTENTU DENGAN CEPAT. Semoga artikel ini bermanfaat.
Catatan Penting: Jika tampilan VBA macro (ALT+F11) tidak muncul maka kalian perlu mengaktifkan VBA Macro Ms. Excel di PC anda, caranya akan saya bahas pada tulisan berikutnya.
Jangan lupa, like, comment, dan subscribe youtube channel onny putranto disini, untuk mendapatkan update tutorial IT terbaru. Terima kasih.
Bagaimana script VBA nya jika nama Workbooknya mau disesuaikan dengan nama kategorinya?
BalasHapusTidak perlu diganti, karena script sudah kita masukkan dalam workbook saat kita menekan ALT+F11, sedangkan kategori silahkan buat di kolom B seperti di contoh di gambar 2 & gambar 3-Langkah Nomor 2
HapusKalau setelah di split terus di save as, itu gimana ya?
BalasHapusFile akan pecah sebanyak jumlah kategori yg dditetapkan diawal... save as seperti biasa saja
HapusSub SplitSheetDataIntoMultipleWorkbooksBasedOnSpecificColumn() Dim objWorksheet As Excel.Worksheet Dim nLastRow, nRow, nNextRow As Integer Dim strColumnValue As String Dim objDictionary As Object Dim varColumnValues As Variant Dim varColumnValue As Variant Dim objExcelWorkbook As Excel.Workbook Dim objSheet As Excel.Worksheet Set objWorksheet = ActiveSheet nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row Set objDictionary = CreateObject("Scripting.Dictionary") For nRow = 2 To nLastRow 'Pilih kategori khusus 'Disini saya gunakan kolom B 'Gunakan Kolom B dalam kasus lain strColumnValue = objWorksheet.Range("B" & nRow).Value If objDictionary.Exists(strColumnValue) = False Then objDictionary.Add strColumnValue, 1 End If Next varColumnValues = objDictionary.Keys For i = LBound(varColumnValues) To UBound(varColumnValues) varColumnValue = varColumnValues(i) 'Script buat workbook baru Set objExcelWorkbook = Excel.Application.Workbooks.Add Set objSheet = objExcelWorkbook.Sheets(1) objSheet.N
BalasHapusame = objWorksheet.Name objWorksheet.Rows(1).EntireRow.Copy objSheet.Activate objSheet.Range("A1").Select objSheet.Paste For nRow = 2 To nLastRow If CStr(objWorksheet.Range("B" & nRow).Value) = CStr(varColumnValue) Then 'copy data dengan clom B yang sama sebagai nilai kategori objWorksheet.Rows(nRow).EntireRow.Copy nNextRow = objSheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1 objSheet.Range("A" & nNextRow).Select objSheet.Paste objSheet.Columns("A:B").AutoFit End If Next Next End Sub
Malah muncul gini waktu copy script nya gan