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

Attachment: re-input dg macro.xlsb
Description: application/vnd.ms-excel.sheet.binary.macroenabled.12

Reply via email to