Coba isi prosedurnya adalah :
Dim rngDT1 As Range, rngDT2 As Range
Dim lRec As Long
Set rngDT2 = Sheets("data
2").Range("a5") 'anchor lokasi data 2
lRec = WorksheetFunction.Count(rngDT2.CurrentRegion.Resize(, 1)) +
1 'jumlah baris record dan headernya data 2
With Sheets("data 1")
Set rngDT1 =
.Range("a5").CurrentRegion 'set area data
'sembunyikan kolom tak terpakai
.Columns("f:o").EntireColumn.Hidden = True
.Columns("q:r").EntireColumn.Hidden = True
.AutoFilterMode =
False 'autofilter di off
rngDT1.AutoFilter 16,
">0" 'filter kolom sak pcs >0
(kolom ke-16)
'copas values dari data 1 ke data 2
rngDT1.Offset(1).SpecialCells(xlCellTypeVisible).Copy
rngDT2.Offset(lRec).PasteSpecial xlPasteValues, SkipBlanks:=True
lRec = rngDT1.Resize(, 1).SpecialCells(xlCellTypeVisible).Count -
1 'hitung jumlah record di copas (tanpa header)
.AutoFilterMode =
False 'autofilter di off
'tampilkan kembali seluruh kolom yang di-hide
.Columns("f:r").EntireColumn.Hidden = False
End With
'pesan selesai
MsgBox "Done." & vbCrLf & "Record di salin : " & lRec, vbInformation,
"Copas Data 1 ke Data 2 :: Selesai"
Thank You and Regards.
Kid.
2011/9/30 Darto Chandra <[email protected]>
> **
>
>
> terlampir file kerjaan saya. Pada sheet menu periode january terdapat
> command button menu. didalamnya terdapat tombol tutup bulan.mohon bantuannya
> untuk menulis makro di tombol tersebut. Pengennya kalo tombol tersebut di
> pencet data yang ada di sheet data1 dengan cell tally, T,L,P,Grade,SAK[PCS]
> akan berpindah ke sheet data2 dan menempati cell tally,T,L,P,SAW[PCS] dengan
> catatan SAK[PCS} di Data1 bukan nol.
> Terima kasih.
>
> maaf sebelumnya, atas posting kemaren yang melebihi batas.
>
> Darto Chandra
> 085881648818
>
>
>
>
