Rasa kangen terhadap blog ini saya luapkan dengan mengubah tampilan dengan template yang lebih ringan dari sebelumnya, Ya..!! biar mudah dan agar tidak lambat loading saat mengakses oleh pembaca yang mencari ilmu tentang Vba yang saya tuliskan disini.
Cara MengCopy/Mentransfer Data Dengan Kreteria |
Terimakasih kepada Master blogger musdeoranje.net Yang telah merekomendasikan template ini untuk saya pakai. Sebenarnya saya lebih menyukai tempilan sebelumnya.
Namun untuk kenyamanan para pembaca saya merelakan selera saya untuk saya tinggalkan. Chiiee.. Chiiee...!!
Kembali fokus ke Pembahasan VBA Excel..!! Pada kesempatan ini saya akan membeberkan Cara Copy Data atau Transfer Data Dengan Kreteria Tertentu Ke Sheet Yang Berbeda-beda menurut kreteria masing-masing. Anda dapat memperhatikan gambar format gif dibawah agar dapat lebih cepat memahami tujuan dari posting ini.
Pada gambar gif dibawah terdapat Sheet "Data" yang merupakan sumber data yang akan kita Copy. Perhatikan kolom dengan judul headernya Kelas, terdapat isian kelas 7-A, 8-A, dan 9-A dalam kolomnya. Berdasarkan isian kelas tersebut kita akan mengambil datanya dan mentranfer ke masing-masing sheet lain berdasarkan kelasnya.
Jadi Setiap data Kelas 7-A akan di Transfer ke Sheet dengan "7-A", data Kelas 8-A akan ditransfer ke Sheet "8-A" dan Kelas 9-A akan di transfer ke Sheet "9-A".
Langkah-langkah Cara Copy/Transfer Data Dengan Kreteria Tertentu Ke Sheet Yang Berbeda Menurut Kreteria Masing-Masing sebagai berikut :
- Buka Excel, bikin table dan masukkan data seperti yang terlihat pada gambar dan ubah nama "Sheet1" menjadi "Data". Untuk sheet lainnya bikin nama sheet "7-A", "8-A" dan "9-A". Save File Excel dalam format Enable Macro atau Binary.
- Selanjutnya Klik Developer, pilih Insert dan pilih Button di Form Controls dan sesuaikan ukuran dan letakknya. Edit nama button dengan nama "TRANFER DATA".
- Klik kanan pada tombol TRANSFER DATA pilih New dan masukkan Code berikut ini di modulnya.
Sub copyPasteData()
Dim strSourceSheet As String
Dim strDestinationSheet As String
Dim lastRow As Long
strSourceSheet = "Data"
Sheets(strSourceSheet).Visible = True
Sheets(strSourceSheet).Select
Range("C2").Select
Do While ActiveCell.Value <> ""
strDestinationSheet = ActiveCell.Value
ActiveCell.Offset(0, -2).Resize(1, ActiveCell.CurrentRegion.Columns.Count).Select
Selection.Copy
Sheets(strDestinationSheet).Visible = True
Sheets(strDestinationSheet).Select
lastRow = LastRowInOneColumn("A")
Cells(lastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets(strSourceSheet).Select
ActiveCell.Offset(0, 2).Select
ActiveCell.Offset(1, 0).Select
Loop
MsgBox ("Transfer Data Ke Masing-Masing Sheet Kelas Selesai")
End Sub
Public Function LastRowInOneColumn(col)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function
- Selesai..!! Uji aplikasi dengan klik Run atau dengan menekan tombol F5 pada keyboard. Bila perancangan dan penempatan kode sudah anda ikuti dengan benar maka aplikasi akan berjalan seperti yang terlihat pada gambar gif diatas.
Download : Sample File Copy/Tranfer Data
Semoga dapat dijadikan acuan dan referensi dalam membuat aplikasi berbasis Excel Vba.