Coba kode berikut: Sub FilterQtt() Dim nRecord As Long, rgInput As Range 'setting range input, termasuk header / nama field 'yang diproses hanya 3 kolom (3 fields) Set rgInput = [A1].CurrentRegion.Resize(, 3) 'jika kolom quantity kosong tampilkan pesan If WorksheetFunction.Sum(rgInput) = 0 Then MsgBox "kolom quantity kosong", vbCritical Exit Sub End If 'setting filter criteria Dim rgCriteria As Range Set rgCriteria = [D1:D2] rgCriteria = WorksheetFunction.Transpose(Array("QTY", ">0")) 'jika sheet dalam kondisi terfilter, tamplikan semua data If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'mulai filter di sheet aktic rgInput.AdvancedFilter xlFilterInPlace, rgCriteria With Sheets("P1") 'menghitung jumlah record di sheet target dan baris tujuan nRecord = .Range("A1").CurrentRegion.Rows.Count 'mengambil data terfilter tanpa kolom header Set rgInput = rgInput.Offset(1, 0) 'copy data ke sheet tujuan rgInput.SpecialCells(xlCellTypeVisible).Copy .Range("A" & nRecord + 1) End With 'mengembalikan data ke un-filtered ActiveSheet.ShowAllData 'menghapus filter kriteria rgCriteria.ClearContents End Sub
From: belajar-excel@yahoogroups.com [mailto:belajar-excel@yahoogroups.com] On Behalf Of Dede Suparman Sent: Friday, June 21, 2013 9:18 AM To: belajar-excel@yahoogroups.com Subject: [belajar-excel] input dengan macro Dear Para Master & Rekan - Rekan Be-Excel, Assalamu'alaikum Wr.Wb, Jangan bosen ya, mohon bantuan nya saya membuat input sederhana dengan macro. Alur nya ,input yang ada angka nya saja di kolom QTY , problem nya ketika di kolom QTY tidak ada angka nya pas diinput semua item jadi keinput semua. mohon bantuannya ketika kolom QTY tidak ada angka satupun item nya juga tidak keinput + ada msgbox peringatan bahwa QTY blm diiput. terimakasih sebelumnya , File terlampir. salam, Del
re-input dg macro.xlsb
Description: application/vnd.ms-excel.sheet.binary.macroenabled.12