Dear Be Exceler,
maaf, ternyata script dari Jan yang tadi hanya berjalan dengan baik di file
Sample.xls, jika ada waktu senggang nanti akan coba Jan perbaiki agar dapat
berjalan di kedua file, jika ada Be-Exceler yang ingin memperbaiki script
dari Jan, Jan mempersilakan dengan senang hati :)
Best Regard,
Jan Raisin
Pada 21 November 2012 15:34, Jan Raisin <miss.jan.rai...@gmail.com> menulis:
> Dear Be Exceler,
>
> Jan coba berikan solusi ya.. insya ALLAH bisa berjalan di kedua buah file
> yang dilampirkan oleh mr Kid
>
> script berikut di tulis di dalam sebuah modul VBA, untuk mengatifkannya
> dari lembar keja dengan cara menekan tombol F11
>
> Option Explicit
> ' --------------------------- '
> ' Code by: Miss Jan Raisin '
> ' untuk millis Belajar Excel '
> ' 21 November 2012 '
> ' --------------------------- '
>
> ' ini adalah nama prosedurnya
> Sub RekapData()
>
> ' deklarasikan variabel bertipe Range untuk menyimpan objek berupa
> range
> ' rgData = range_Data, letaknya di sheet Nota mulai cell H13 samapai
> cell H17
> ' cData = cell_Data, adalah setiap 1 cell di dalam rgData
> Dim rgData, cData As Range
>
> ' deklarasikan variabel untuk menyimpan nomer baris dengan tipe Long
> ' r = nomor baris data pertama di sheet Rekap yaitu baris 7 sampai
> dengan nomer baris terakhir yang ada datanya
> ' data tersebut bisa berupa Null String, atau sebut saja yang nanya
> bikin semacam acara Jebakan Betmen
> ' Brs = nomor baris terakhir yang digunakan, letaknya antah berantah
> ' idxBrs = nomor baris di bawah data yang masih kosong atau Null String
> Dim r, Brs, idxBrs As Long
>
> ' non-aktifkan aplikasi screen update untuk mempercepat kerja macro
> Application.ScreenUpdating = False
>
> ' aktifkan sheet Nota, hal ini untuk berjaga-jaga jika sheet aktif
> bukanlah sheet Nota
> Sheets("Nota").Select
>
> ' tetapkan lokasi rgData, yaitu di sheet Nota >> sudah dipanggil
> sebelumnya
> ' letaknya di cell H13 sampai dengan cell H17
> Set rgData = Range("h13:h17")
>
> ' untuk setiap 1 cell (cData) di dalam rgData
> For Each cData In rgData
>
> ' jika nilai cData <> "" maka
> If cData.Value <> "" Then
>
> ' range cData sampai 8 kolom di sebelah kanan cData dicopy
> ' untuk menunjuk 8 kolom disebelah kanan cData digunakan
> perintah cData.Offset(0, 8)
> ' untuk melakukan copy digunakan perintah .Copy
> Range(cData, cData.Offset(0, 8)).Copy
>
> ' panggil / aktifkan sheet Rekap
> Sheets("Rekap").Select
>
> ' panggil / pergi ke cell A7
> Range("a7").Select
>
> ' saat ini cell aktif berada di cell A7
> ' pada cell aktif cek apakah ada datanya atau tidak
> ' jika pada aktif cell ada datanya, maka
> If ActiveCell.Value <> "" Then
>
> ' hitung nilai baris paling akhir yang berisi data
> ' bisa saja berupa Null String yang letaknya di antah
> berantah
> ' untuk mengetahui letak cell digunakan perintah
> .SpecialCells(xlCellTypeLastCell)
> ' untuk mengetahui nomer barisnya digunakan perintah .Row
> ' lalu nomer baris tersebut disimpan dalam sebuah variabel
> bernama Brs
> Brs = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
>
> ' jika nilai Brs lebih besar dari 7
> ' kenapa harus 7? karena TS meminta data pertama berada di
> cell A7 (kolom A, baris 7)
> ' jika Brs lebih besar dari 7, maka
> If Brs > 7 Then
>
> ' lakukan loop mulai dari baris 7 sampai dengan nomer
> baris yang disimpan dalam variabel Brs
> For r = 7 To Brs
>
> ' lalukan pengecekan kondisi, apakah di baris
> tersebut pada kolom 1 ada datanya atau tidak
> ' untuk menunjukknya menggunakan perintah Cells(r,
> 1)
> ' syntaxnya adalah Cells(nomer_baris , nomer_kolom)
> ' jika pada baris tersebut pada kolom 1 tidak ada
> datanya atau Null Sring, maka
> If Cells(r, 1).Value = "" Then
>
> ' ambil nilai berisnya menggunakan perintah
> .Row
> ' lalu disimpan dalam variabel bernama idxBrs
> idxBrs = Cells(r, 1).Row
>
> ' jika sudah ketemu, lalu keluar dari loop
> Exit For
>
> ' ini adalah akhir dari pengecekan data pada sheet
> Rekap
> End If
>
> ' jika belum ketemu cell dengan data yang kosong, maka
> lanjutkan dengan baris berikutnya
> Next r
>
> ' ini adalah akhir pengecekan jika nilai Brs lebih besar
> dari 7
> End If
>
> ' panggil cell yang terpilih
> ' yaitu nomer baris sesuai nilai yang didapat dalam idxBrs
> dan kolom 1
> Cells(idxBrs, 1).Select
>
> ' ini adalah akhir pengecekan apakah cell A7 di sheet Rekap
> ada datanya atau tidak
> End If
>
> ' pada aktif cell sesuai dengan pengecekan beberapa kondisi di
> atas
> ' dilakukan paste special sesuai dengan nilai dan format data
> asal
> ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
>
> ' setelah itu matikan aplikasi copy paste
> Application.CutCopyMode = False
>
> ' yang ini adalah akhir dari pemeriksaan apakah cData ada datanya
> atau tidak
> End If
>
> ' panggil kembali sheet Nota, karena saat ini yang aktif adalah
> sheet Rekap
> Sheets("Nota").Select
>
> ' lanjutkan untuk setiap cData berikutnya
> Next cData
>
> ' aktifkan aplikasi screen update
> Application.ScreenUpdating = True
>
> ' yang ini adalah akhir dari prosedur
> End Sub
>
> Lalu prosedur tersebut harus dipanggil melalui tombol yang sudah dibuat
> oleh TS, Jan sengaja tidak melampirkan file yang sudah jadi :D
>
> Best Regard,
>
> -Jan Raisin-
>
>
> Pada 21 November 2012 11:07, Mr. Kid <mr.nm...@gmail.com> menulis:
>
> **
>>
>>
>> Dear BeExceller,
>>
>> Sepertinya penanya belum mengirmkan file lampiran yang lebih sesuai
>> peraturan milis.
>>
>> File terlampir :
>> 1. sample.xls adalah file dari penanya yang sudah dibersihkan sebagian
>> baris-baris kosong atau baris-baris nullstring nya, dengan menyisakan
>> sedikit di sheet rekap tentang keadaan sesungguhnya file dari penanya yang
>> berpotensi menjebak para BeExceller ketika akan membuat prosedur penulisan
>> data ke sheet rekap melalui VBA.
>>
>> 2. Sample_yang_relatif_clean.xls adalah file yang sheet rekapnya juga
>> sudah dibersihkan.
>>
>> BeExceller seluruhnya, selamat berkreasi dengan file terlampir. Silakan
>> pilih file yang mana saja untuk mencoba membuat VBA menulis ke sheet rekap.
>>
>> Wassalam,
>> Kid.
>>
>>
>> 2012/11/21 Ugenk Hksn <ugen...@yahoo.com>
>>
>>> **
>>>
>>>
>>> Para pakar excel....
>>> Tolong macro combo utk mencopy ke sheet lain
>>> Maaf masih newbie....File terlampir
>>> Terima kasih
>>>
>>> Wasalam
>>>
>>> ugenk
>>>
>>> --- Mods ---
>>> File lampiran 4MB dicekal.
>>> Semoga penanya bersedia posting file dengan ukuran sesuai peraturan
>>> milis (max 250KB)
>>> ------------
>>> _
>>>
>>>
>>
>>
>
>
