Sisip Baris Sekaligus

Sebelumnya sudah dibahas mengenai contoh code macro untuk menghapus baris kosong sekaligus. Nah pada postingan kali ini berlaku sebaliknya. Kita akan mempraktekann contoh code macro untuk menyisipkan baris sekaligus pada lembar kerja Microsoft Excel. 

Ide awalnya adalah bahwa secara konvensional kita biasanya menyisipkan baris dengan terlebih dahulu mengidentifikasi keberadaan text tertentu. Misalnya jika ingin menambahkan baris kosong dibawah setiap baris "Total", maka kita akan mencari baris "Total" terlebih dahulu, kemudian seleksi baris di bawah baris total, lalu klik kanan --> insert

Prosedur sisip baris atau Insert Row secara manual biasanya dilakukan satu persatu. Tidak begitu menjadi masalah jika jumlah row hanya sedikit. Tetapi jika mencapai ratusan atau ribuan, maka cara konvensional cukup merepotkan.

Untungnya ada macro / VBA yang dapat menjalankan tugas tersebut dengan sangat cepat.

Sisip Satu Baris Penuh Diatas Setiap Sel Berisi Text Tertentu

Sub SisipSatuBarisPenuhDiAtasTextTanda() Dim rgTanda As Range, Tanda As Variant, i As Long Dim selCek As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If TypeName(Selection) <> "Range" Then MsgBox "Range Terpilih Tidak Valid" Exit Sub End If Set rgTanda = Selection Set rgTanda = rgTanda.Columns(1) Do Tanda = Application.InputBox("Masukan Text Sebagai Tanda Sisip") If Tanda = "" Then MsgBox "Tanda tidak boleh kosong", vbCritical Loop Until Tanda <> "" If Tanda = False Then Exit Sub For i = rgTanda.Rows.Count To 1 Step -1 Set selCek = rgTanda.Cells(i, 1) If selCek.Value = Tanda Then selCek.EntireRow.Insert End If Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

Sisip Satu Baris Penuh Diatas Setiap Sel Berisi Text Tertentu

Sub SisipSatuBarisPenuhDiBawahTextTanda() Dim rgTanda As Range, Tanda As Variant, i As Long Dim selCek As Range Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If TypeName(Selection) <> "Range" Then MsgBox "Range Terpilih Tidak Valid" Exit Sub End If Set rgTanda = Selection Set rgTanda = rgTanda.Columns(1) Do Tanda = Application.InputBox("Masukan Text Sebagai Tanda Sisip") If Tanda = "" Then MsgBox "Tanda tidak boleh kosong", vbCritical Loop Until Tanda <> "" If Tanda = False Then Exit Sub For i = rgTanda.Rows.Count To 1 Step -1 Set selCek = rgTanda.Cells(i, 1) If selCek.Value = Tanda Then selCek.Offset(1, 0).EntireRow.Insert End If Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

Sisip Beberapa Baris Penuh Diatas Setiap Sel Berisi Text Tertentu

Sub SisipBeberapaBarisPenuhDiAtasTextTanda() Dim rgTanda As Range, Tanda As Variant, i As Long Dim selCek As Range, jmlBarisSisip As Variant Dim inputValid As Boolean Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If TypeName(Selection) <> "Range" Then MsgBox "Range Terpilih Tidak Valid" Exit Sub End If Set rgTanda = Selection Set rgTanda = rgTanda.Columns(1) Do Tanda = Application.InputBox("Masukan Text Sebagai Tanda Sisip") If Tanda = False Then Exit Sub 'prosedur diakhiri jika user tekan tombol cancel inputValid = Not Tanda = "" If inputValid = False Then MsgBox "Inputan tidak boleh kosong", vbCritical Loop Until inputValid Do jmlBarisSisip = Application.InputBox("Masukan Jumlah Baris Sisip antara 1 s/d 10") If jmlBarisSisip = False Then Exit Sub 'prosedur diakhiri jika user tekan tombol cancel inputValid = (IsNumeric(jmlBarisSisip) And Not (jmlBarisSisip < 1) And Not (jmlBarisSisip > 10)) If inputValid = False Then MsgBox "Jumlah baris sisip harus berupa angka 1 s/d 10", vbCritical Loop Until inputValid jmlBarisSisip = Int(jmlBarisSisip) For i = rgTanda.Rows.Count To 1 Step -1 Set selCek = rgTanda.Cells(i, 1) If selCek.Value = Tanda Then Range(selCek, selCek.Offset(jmlBarisSisip - 1)).EntireRow.Insert End If Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

Sisip Beberapa Baris Penuh Dibawah Setiap Sel Berisi Text Tertetu

Sub SisipBeberapaBarisPenuhDiBawahTextTanda() Dim rgTanda As Range, Tanda As Variant, i As Long Dim selCek As Range, jmlBarisSisip As Variant Dim inputValid As Boolean Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If TypeName(Selection) <> "Range" Then MsgBox "Range Terpilih Tidak Valid" Exit Sub End If Set rgTanda = Selection Set rgTanda = rgTanda.Columns(1) Do Tanda = Application.InputBox("Masukan Text Sebagai Tanda Sisip") If Tanda = False Then Exit Sub 'prosedur diakhiri jika user tekan tombol cancel inputValid = Not Tanda = "" If inputValid = False Then MsgBox "Inputan tidak boleh kosong", vbCritical Loop Until inputValid Do jmlBarisSisip = Application.InputBox("Masukan Jumlah Baris Sisip antara 1 s/d 10") If jmlBarisSisip = False Then Exit Sub 'prosedur diakhiri jika user tekan tombol cancel inputValid = (IsNumeric(jmlBarisSisip) And jmlBarisSisip >= 1 And jmlBarisSisip <= 10) If inputValid = False Then MsgBox "Jumlah baris sisip harus berupa angka 1 s/d 10", vbCritical Loop Until inputValid jmlBarisSisip = Int(jmlBarisSisip) For i = rgTanda.Rows.Count To 1 Step -1 Set selCek = rgTanda.Cells(i, 1) If selCek.Value = Tanda Then Range(selCek.Offset(1, 0), selCek.Offset(jmlBarisSisip)).EntireRow.Insert End If Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

***

Demikian beberapa contoh code macro VBA yang terkait sisip - mensisip baris / row di excel. Semoga bermanfaat.

Barangkali teman-teman tertarik mengetahui contoh-contoh code macro VBA lainnya, silahkan cek tautan di bawah ini. 

• Menghapus Baris Kosong Sekaligus
• Mengubah Konten Sel Menjadi Komentar
• Memindahkan Text dari Kotak Komentar ke Sel

Jika teman-teman ada saran atau koreksi, jangan segan-segan untuk tinggalkan pesan di kolom komentar.