Mantap juga nih rumus dari Pak Seno...nambah ilmu maning asyik. Lanjutkan
pak jika ada cara lainnya yang lebih simple atau bisa untuk data yang lebih
kompleks.
2012/1/30 o' Seno <ontosen...@gmail.com>
> **
>
>
> cara sedikit lain: mencari AngkaPOSISI (index) Label Baris
>
> Jika pak sudarsono sudah mencontohkan menggunakan Method FIND;
> mari Kita cuba menggunakan fungsi MATCH
>
> Cara ini saya lihat pernah dipamerkan juga oleh Haps di suatu kasus
>
> Sub CopyPaste()
> ' code racikan dari o'SEno
> ' memanfaatkan fungsi MATCH
> '--------------------------
> Dim dataTABEL As Range, dataREKAP As Range
> Dim TBL_ColHeadr As Range, TBL_RowLabel As Range
> Dim iRow As Integer, iCol As Integer
> Dim xRow As Integer, xCol As Integer
>
> Set dataTABEL = Sheet1.Cells(1).CurrentRegion ' (sht Data)
> Set dataREKAP = Sheet2.Cells(1).CurrentRegion ' (sht Hasil)
> Set TBL_ColHeadr = dataTABEL.Resize(1, dataTABEL.Columns.Count)
> Set TBL_RowLabel = dataTABEL.Resize(dataTABEL.Rows.Count, 1)
>
> For iRow = 2 To dataREKAP.Rows.Count
> 'mencari posisi Baris
> xRow = 0: On Error Resume Next
> xRow = WorksheetFunction.Match(dataREKAP(iRow, 1), TBL_RowLabel, 0)
>
> For iCol = 2 To dataREKAP.Columns.Count
> ' mencari posisi Kolom
> xCol = 0: On Error Resume Next
> xCol = WorksheetFunction.Match(dataREKAP(1, iCol), TBL_ColHeadr,
> 0)
> 'sumber data dicopy
> dataTABEL(xRow, xCol).Copy
> ' dipaste special ke Rekap/hasil
> dataREKAP(iRow, iCol).PasteSpecial xlPasteValues
> dataREKAP(iRow, iCol).PasteSpecial xlPasteComments
> Next iCol
> Next iRow
> Application.CutCopyMode = False
> End Sub
>
>
> *o'Seno*
>
>
>
> 2012/1/30 Isti Astro <milisas...@gmail.com>
>
>> **
>> Dear All Master,
>>
>> Mohon bantuannya makro untuk copy paste tapi hanya value plus commentnya
>> saja, untuk format dan lainnya tidak ikut ter-paste di cell yang dituju.
>> Adapun koding yang sudah ada saya ambil dari Bu Haps & Pak Seno dengan
>> sedikit modifikasi tapi masih bingung juga, berikut makronya:
>>
>> ====================================================================================
>> Sub CopyPaste()
>> Dim dataTbl As Range, dataRekap As Range, Rng As Range
>> Dim Row As Integer, Col As Integer
>> Dim i As Long
>>
>> Set dataTbl = Sheet1.Range("B1:D4").CurrentRegion.Offset(1, 0) ' *Sheet
>> berubah* sesuai dengan data tabel sumber
>> Set dataRekap = Sheet2.Cells(1).CurrentRegion.Offset(1, 0)
>>
>> For Row = 2 To dataTbl.Rows.Count
>> For Col = 2 To dataTbl.Columns.Count
>> Set Rng = Sheet2.Range("B1:D1").Find(Col, LookIn:=xlValues)
>> i = Rng.Column
>> dataRekap(RekRow, i) = dataTbl(Row, Col) ' Jika pakai
>> coding ini hanya value saja yang ke paste, maunya plus
>>
>> ' commentnya
>> Next Col
>> Next Row
>> End Sub
>> ============================================================
>> Tabel kasus terlaimpir. Terima kasih.
>>
>> regards,
>> Isti
>>
>
>
