Kamis, 29 September 2011

[belajar-excel] Digest Number 1342

Messages In This Digest (25 Messages)

1a.
Re: Menggabungkan tabel antar book From: dioni aditama
1b.
Re: Menggabungkan tabel antar book From: Kid Mr.
2a.
Re: saldo akhir pindah ke saldo awal From: Kid Mr.
2b.
saldo akhir pindah ke saldo awal From: Darto Chandra
2c.
Re: saldo akhir pindah ke saldo awal From: Kid Mr.
2d.
Re: saldo akhir pindah ke saldo awal From: STDEV(i)
2e.
saldo akhir pindah ke saldo awal From: Darto Chandra
3a.
Re: Menjumlahkan yang berisi angka saja From: Kid Mr.
3b.
Re: Menjumlahkan yang berisi angka saja From: Senja Laura
4a.
Re: Dynamic range otomatis te-sort From: Kid Mr.
5a.
Copy range dari file lain gagal dihadang Paste Special From: Yudha Saptiadi
5b.
Re: Copy range dari file lain gagal dihadang Paste Special From: Kid Mr.
5c.
Re: Copy range dari file lain gagal dihadang Paste Special From: Yudha Saptiadi
5d.
Re: Copy range dari file lain gagal dihadang Paste Special From: Kid Mr.
5e.
Re: Copy range dari file lain gagal dihadang Paste Special From: Yudha Saptiadi
5f.
Re: Copy range dari file lain gagal dihadang Paste Special From: Kid Mr.
5g.
Re: Copy range dari file lain gagal dihadang Paste Special From: Yudha Saptiadi
5h.
Re: Copy range dari file lain gagal dihadang Paste Special From: Kid Mr.
6.1.
Re: Update Tabel dari sheet lain... From: jkssxls Sudarsono
7.
Buat Login Pada Excel From: Henry Sitohang
8.
Macro passkey document & disabled macro From: isti_astro
9a.
Bls: [belajar-excel] Chart dinamis, format conditional & row dinamis From: Dewan Deya
9b.
Re: Chart dinamis, format conditional & row dinamis From: Kid Mr.
10.
Pembalian dana pst batal From: Yusril Ramadani
11.
perbandingan 2 kolom 2 kriteria From: Jonathan Susanto

Messages

1a.

Re: Menggabungkan tabel antar book

Posted by: "dioni aditama" dioniaditama@yahoo.co.id   dioniaditama

Thu Sep 29, 2011 10:39 am (PDT)



Kok error ya pak,variabel not defined.logikanya kan saya manggil book1 trus copy 12 tabel pd 12 sheet seperti yg sudah. kok masih gak bisa ya??

Public Sub GabungBook1()
    Dim wbk As Workbook
Set wbk = workbboks.Open("drive:D\excelku\Book1.xlsm")
    Dim shtCol As Worksheet
    Dim rngComb As Range, rngDT As Range
    Dim lRows As Long, lRecords As Long
    Dim lMonth As Long, lYear As Long
    Dim sMsg As String
   
    Application.ScreenUpdating = False
    sMsg = "Penggabungan Selesai." & vbCrLf & vbCrLf & _
            "SheetName: | RowsCount:" & vbCrLf
    Set rngComb = Sheets("combine").Range("a6")
    rngComb.CurrentRegion.Offset(1).EntireRow.Delete
    For Each shtCol In Sheets(Array(Sheet1.Name, Sheet2.Name, Sheet3.Name, _
                                    Sheet4.Name, Sheet5.Name, Sheet6.Name, _
                                    Sheet7.Name, Sheet8.Name, Sheet9.Name, _
                                    Sheet10.Name, Sheet11.Name, Sheet12.Name))
        lMonth = lMonth + 1
        lYear = Year(Date)
       
        'hitung jumlah baris data
        lRows = WorksheetFunction.Count(shtCol.Range("a:a").EntireColumn)
        sMsg = sMsg & shtCol.Name & vbTab & vbTab & lRows & vbCrLf
        If lRows > 0 Then
            With rngComb.Offset(1)
                'copas
                shtCol.Range("a7").Resize(lRows, 6).Copy .Offset(lRecords).Resize(1, 1)
           
                'susun data tanggal yang baik
                .Offset(, 12).Resize(1, 1).Formula = "=date(" & lYear & "," & lMonth & ",0)"     'template tanggal bertype datetime
                .Parent.Calculate                       'kalkulasi sheet (antisipasi setting calculation manual)
                'copas values add template tanggal ke data tanggal
                .Offset(, 12).Resize(1, 1).Copy
                .Offset(lRecords).Resize(lRows, 1).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
                .Offset(lRecords).Resize(lRows, 1).NumberFormat = "DD-MMM-YYYY"
                .Offset(, 12).Resize(1, 1).ClearContents     'hapus template datetime
               
                lRecords = lRecords + lRows
            End With
        End If
    Next shtCol

Mohon bantuannya pak

Terima kasih

Dioni
--- Pada Ming, 18/9/11, Kid Mr. <mr.nmkid@gmail.com> menulis:

Dari: Kid Mr. <mr.nmkid@gmail.com>
Judul: Re: [belajar-excel] Re: Menggabungkan tabel antar book
Kepada: belajar-excel@yahoogroups.com
Tanggal: Minggu, 18 September, 2011, 10:04 PM

 

Jadi data ini tidak akan digunakan sebagai data source penyusunan report.

dim wbk as workbook
set wbk=workbboks.open( "drive:\foldernya\nama filenya.ekstensinya")

Yang di biru disesuaikan dengan file fullname.

Kid.

1b.

Re: Menggabungkan tabel antar book

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 1:10 pm (PDT)



Dim wbk As Workbook
Dim shtCol As Worksheet
Dim rngComb As Range, rngDT As Range
Dim lRows As Long, lRecords As Long
Dim lMonth As Long, lYear As Long
Dim sMsg As String

Application.ScreenUpdating = False
sMsg = "Penggabungan Selesai." & vbCrLf & vbCrLf & _
"SheetName: | RowsCount:" & vbCrLf
*Set wbk = workbboks.Open("Z:\excelku\Book1.xlsm")*
Set rngComb = *wbk.*Sheets("combine").Range("a6")
rngComb.CurrentRegion.Offset(1).EntireRow.Delete
For Each shtCol In *wbk.*Sheets(Array(Sheet1.Name, Sheet2.Name,
Sheet3.Name, _
Sheet4.Name, Sheet5.Name, Sheet6.Name, _
Sheet7.Name, Sheet8.Name, Sheet9.Name, _
Sheet10.Name, Sheet11.Name,
Sheet12.Name))

Yang biru bisa diganti-ganti dengan nama file lain (gantian dari book1
sampai bookN)
kalau gak mau manual, pelajari dasar VBA yang ada dimilis tentang set nilai
cell, ambil nilai cell, loop dengan for next dan loop dengan for each next
Milis sudah menyediakan di bagian files. Berkunjunglah ke milis disini :
http://tech.groups.yahoo.com/group/belajar-excel
Disana ada folder files dan sebagainya.

Kid.

On Thu, Sep 29, 2011 at 21:07, dioni aditama <dioniaditama@yahoo.co.id>wrote:

> **
>
>
> Kok error ya pak,variabel not defined.logikanya kan saya manggil book1 trus
> copy 12 tabel pd 12 sheet seperti yg sudah. kok masih gak bisa ya??
>
> Public Sub GabungBook1()
> Dim wbk As Workbook
> Set wbk = workbboks.Open("drive:D\excelku\Book1.xlsm")
> Dim shtCol As Worksheet
> Dim rngComb As Range, rngDT As Range
> Dim lRows As Long, lRecords As Long
> Dim lMonth As Long, lYear As Long
> Dim sMsg As String
>
> Application.ScreenUpdating = False
> sMsg = "Penggabungan Selesai." & vbCrLf & vbCrLf & _
> "SheetName: | RowsCount:" & vbCrLf
> Set rngComb = Sheets("combine").Range("a6")
> rngComb.CurrentRegion.Offset(1).EntireRow.Delete
> For Each shtCol In Sheets(Array(Sheet1.Name, Sheet2.Name, Sheet3.Name,
> _
> Sheet4.Name, Sheet5.Name, Sheet6.Name,
> _
> Sheet7.Name, Sheet8.Name, Sheet9.Name,
> _
> Sheet10.Name, Sheet11.Name,
> Sheet12.Name))
> lMonth = lMonth + 1
> lYear = Year(Date)
>
> 'hitung jumlah baris data
> lRows = WorksheetFunction.Count(shtCol.Range("a:a").EntireColumn)
> sMsg = sMsg & shtCol.Name & vbTab & vbTab & lRows & vbCrLf
> If lRows > 0 Then
> With rngComb.Offset(1)
> 'copas
> shtCol.Range("a7").Resize(lRows, 6).Copy
> .Offset(lRecords).Resize(1, 1)
>
> 'susun data tanggal yang baik
> .Offset(, 12).Resize(1, 1).Formula = "=date(" & lYear & ","
> & lMonth & ",0)" 'template tanggal bertype datetime
> .Parent.Calculate 'kalkulasi sheet
> (antisipasi setting calculation manual)
> 'copas values add template tanggal ke data tanggal
> .Offset(, 12).Resize(1, 1).Copy
> .Offset(lRecords).Resize(lRows, 1).PasteSpecial
> xlPasteValues, xlPasteSpecialOperationAdd
> .Offset(lRecords).Resize(lRows, 1).NumberFormat =
> "DD-MMM-YYYY"
> .Offset(, 12).Resize(1, 1).ClearContents 'hapus
> template datetime
>
> lRecords = lRecords + lRows
> End With
> End If
> Next shtCol
>
> Mohon bantuannya pak
>
> Terima kasih
>
> Dioni
> --- Pada *Ming, 18/9/11, Kid Mr. <mr.nmkid@gmail.com>* menulis:
>
>
> Dari: Kid Mr. <mr.nmkid@gmail.com>
> Judul: Re: [belajar-excel] Re: Menggabungkan tabel antar book
> Kepada: belajar-excel@yahoogroups.com
> Tanggal: Minggu, 18 September, 2011, 10:04 PM
>
>
>
>
> Jadi data ini *tidak akan digunakan *sebagai data source penyusunan
> report.
>
> dim wbk as workbook
> set wbk=workbboks.open( "*drive:\foldernya\nama filenya.ekstensinya*")
>
> Yang di *biru *disesuaikan dengan *file fullname*.
>
> Kid.
>
>
>
>
>
>
>
2a.

Re: saldo akhir pindah ke saldo awal

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 1:43 pm (PDT)



Sambil menunggu rilis resmi file attachment dari Pak Darto.
Dilampirkan penggalan data dari file attachment Pak Darto yang melebihi
batas.
File asli telah dipotong dan dikompresi.
Semoga tidak ada informasi yang hilang.

Kid.

2011/9/29 Darto Chandra <d_c@gmx.com>

> **
>
>
> 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.
>
> Darto Chandra
> 085881648818
>
> -- Mods --
> File lampiran melebihi batas.
> File lampiran akan disusulkan oleh Pak Darto Chandra setelah ukuran file
> memenuhi peraturan milis (<250KB).
> ----------
>
>
>
2b.

saldo akhir pindah ke saldo awal

Posted by: "Darto Chandra" d_c@gmx.com

Thu Sep 29, 2011 6:15 pm (PDT)



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
2c.

Re: saldo akhir pindah ke saldo awal

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 6:50 pm (PDT)



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 <d_c@gmx.com>

> **
>
>
> 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
>
>
>
>
2d.

Re: saldo akhir pindah ke saldo awal

Posted by: "STDEV(i)" setiyowati.devi@gmail.com   siti_vi

Thu Sep 29, 2011 7:40 pm (PDT)



ini mumpung sempat mampir ke milis sebentar... mau criwis dikit boleh ya..

*lha wong* para members diminta bantuan untuk menuliskan makro (harus buka
VBE)
*kok* VBA Projectnya di LOCKED, kepriben seh kiye... masa Darto.. tergesa2
ya... :D..

[image: Locked for Viewing VBA.PNG]

Kepada members lain yg ingin berpartisi*sapi*, file terlampir sudah bisa
dilihat/dibuka
VBA-projectnya (dari diriku, kok bisa cuma 44KB ya..? padahal aslinya yg
kena cekal 1900 KB)

oops, mas Kid malah sudah membuka duluan tanpa ini itu...

~siti

2011/9/30 Darto Chandra <d_c@gmx.com>

> **
> 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
>
2e.

saldo akhir pindah ke saldo awal

Posted by: "Darto Chandra" d_c@gmx.com

Thu Sep 29, 2011 8:17 pm (PDT)



huaduh.......maap beribu maap, terlampir file yang udah di unlock. Thank you mr.kid codingnya cuma belum sempat praktek in.
3a.

Re: Menjumlahkan yang berisi angka saja

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 2:00 pm (PDT)



Dear Laura,

1. Beri header, kemudian gunakan fungsi SumIF
2. Bagaimana jika ada pilihan memo nomor berapa yang akan diinput. Kemudian
akan diwarnai. Jadi tidak pakai Ctrl F

Thank You and Regards,
Kid.

2011/9/29 Senja Laura <4r54ur4@gmail.com>

> Soal kedua saya hari ini mudah-mudahan ada yang menjawab[?]
> Seperti file terlampir
> 1.bagaimana rumusnya untuk penjumlahan pada deret baris di atas (yang ada
> angkanya saja,tanggal dan tempat tidak ikut)
> 2. bisa ngga misal jika saya tekan CTRL+F dan memasukkan kata `Memo10`
> misalnya
> hanya sepanjang baris tersebut yang tersorot (yang warna kuning)dan bisa di
> isi data sehingga kemungkinan salah input di kolom lain menjadi tidak ada
>
>
3b.

Re: Menjumlahkan yang berisi angka saja

Posted by: "Senja Laura" 4r54ur4@gmail.com

Thu Sep 29, 2011 9:05 pm (PDT)



Thanks..Pak kid atas infonya!!!

2011/9/29 Kid Mr. <mr.nmkid@gmail.com>

> Dear Laura,
>
> 1. Beri header, kemudian gunakan fungsi SumIF
> 2. Bagaimana jika ada pilihan memo nomor berapa yang akan diinput. Kemudian
> akan diwarnai. Jadi tidak pakai Ctrl F
>
> Thank You and Regards,
> Kid.
>
>
> 2011/9/29 Senja Laura <4r54ur4@gmail.com>
>
>> Soal kedua saya hari ini mudah-mudahan ada yang menjawab[?]
>> Seperti file terlampir
>> 1.bagaimana rumusnya untuk penjumlahan pada deret baris di atas (yang ada
>> angkanya saja,tanggal dan tempat tidak ikut)
>> 2. bisa ngga misal jika saya tekan CTRL+F dan memasukkan kata `Memo10`
>> misalnya
>> hanya sepanjang baris tersebut yang tersorot (yang warna kuning)dan bisa
>> di isi data sehingga kemungkinan salah input di kolom lain menjadi tidak ada
>>
>>
>
4a.

Re: Dynamic range otomatis te-sort

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 2:53 pm (PDT)



Bu Imar yang baik,

Sebuah data validation list bisa mendapatkan source dari mana saja dalam
workbook.
Ketika data source list nya ada di sheet si data validation itu terpasang,
maka bisa secara langsung digunakan atau dirujuk.
Ketika data source list nya ada di sheet lain, akan lebih mudah jika dibantu
dengan nama range.
Nama range bukanlah sebuah macro, tetapi sebagai pengganti seperti alamat
cell yang ada di pojok kiri atas grid excel (dikiri formula bar).
Nama range yang me-refers to formula yang berisi offset, biasanya bersifat
dinamis. Artinya, setiap ada data baru atau penghapusan data, maka cell-cell
yang terdaftar dalam nama range itu akan berubah juga.

File terlampir adalah contoh data validation yang dinamis.
Untuk file : re-filtered_item_list_validation_r1.xls
Adalah contoh data validation dengan data source list berasal dari sebuah
tabel referensi yang relatif statis.

Untuk file : re-dynamic_data_validation.xlsx
Adalah contoh data validation dengan data source list berasal dari sebuah
tabel transaksi yang dinamis bergerak sesuai kegiatan transaksi data
sehari-hari.

Wassalam.
Kid.

P.S.
Posting berikut dimohon untuk tidak menyertakan CC atau BCC, apalagi cross
posting (TO-nya) ke banyak account. Cukup To : belajar-excel@yahoogroups.com
Jika akan email lewat jalur pribadi, mohon dengan email yang lain, agar
terjaga peraturan milisnya.

2011/9/28 "imar" <imar.ap@gmail.com>

> **
>
>
> Maaf ada yang lupa saya tulis, bagaimana jika tidak menggunakan macro
> tetapi menggunakan formula untuk meng-sort-nya, atau dengan kata lain macro
> yang ada diganti dengan formula.
>
> //BR
>
>
>
5a.

Copy range dari file lain gagal dihadang Paste Special

Posted by: "Yudha Saptiadi" yudhasaptiadi@gmail.com   yudhasaptiadi

Thu Sep 29, 2011 3:16 pm (PDT)



Dear para pakar...

mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range dari file
lain spt terlampir.

paste spesialnya error melulu..

"pastespecial method of range class failed"

Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
v0.1_test.xlsm

atas waktu dan effortnya saya ucapkan terimaksih.

regards,
Yudha
5b.

Re: Copy range dari file lain gagal dihadang Paste Special

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 6:22 pm (PDT)



Bagian :
With book.Worksheets("ACTIVITY")

xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy

End With

* 'create folder with name cost center
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = xcostcenterno*

ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Letakkan yang biru di atas With book.blah
Menjadi :

* 'create folder with name cost center
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = xcostcenterno

* With book.Worksheets("ACTIVITY")

xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy

End With

ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Jika masih error juga, ubah proses copas menjadi :

With book.Worksheets("ACTIVITY")

xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy

ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy

ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End With

Regards.
Kid.

2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>

> **
>
>
>
> Dear para pakar...
>
> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range dari
> file lain spt terlampir.
>
> paste spesialnya error melulu..
>
> "pastespecial method of range class failed"
>
> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
> v0.1_test.xlsm
>
> atas waktu dan effortnya saya ucapkan terimaksih.
>
>
> regards,
> Yudha
>
>
5c.

Re: Copy range dari file lain gagal dihadang Paste Special

Posted by: "Yudha Saptiadi" yudhasaptiadi@gmail.com   yudhasaptiadi

Thu Sep 29, 2011 6:51 pm (PDT)



Mr.Kid...
sudah di coba dua duanya tp
Masih di tendang di paste specialnya
apakah karena intersectnya juga yg harus di perbaiki makronya..??

2011/9/30 Kid Mr. <mr.nmkid@gmail.com>

> **
>
>
> Bagian :
> With book.Worksheets("ACTIVITY")
>
> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
>
> End With
>
> * 'create folder with name cost center
> Set ws = ThisWorkbook.Worksheets.Add
> ws.Name = xcostcenterno*
>
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> Letakkan yang biru di atas With book.blah
> Menjadi :
>
> * 'create folder with name cost center
> Set ws = ThisWorkbook.Worksheets.Add
> ws.Name = xcostcenterno
>
> * With book.Worksheets("ACTIVITY")
>
> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
>
> End With
>
>
>
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> Jika masih error juga, ubah proses copas menjadi :
>
> With book.Worksheets("ACTIVITY")
>
> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> End With
>
> Regards.
> Kid.
>
>
> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>
>> **
>>
>>
>>
>> Dear para pakar...
>>
>> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range dari
>> file lain spt terlampir.
>>
>> paste spesialnya error melulu..
>>
>> "pastespecial method of range class failed"
>>
>> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
>> v0.1_test.xlsm
>>
>> atas waktu dan effortnya saya ucapkan terimaksih.
>>
>>
>> regards,
>> Yudha
>>
>
>
>
5d.

Re: Copy range dari file lain gagal dihadang Paste Special

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 7:01 pm (PDT)



Bagian :
xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
Ganti dengan :
.UsedRange.Copy

Kid.

2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>

> **
>
>
> Mr.Kid...
> sudah di coba dua duanya tp
> Masih di tendang di paste specialnya
> apakah karena intersectnya juga yg harus di perbaiki makronya..??
>
>
> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>
> **
>>
>>
>> Bagian :
>> With book.Worksheets("ACTIVITY")
>>
>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>> Columns.Count))).Copy
>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>> datanya ikut ke copy
>>
>> End With
>>
>> * 'create folder with name cost center
>> Set ws = ThisWorkbook.Worksheets.Add
>> ws.Name = xcostcenterno*
>>
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteAll, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> Letakkan yang biru di atas With book.blah
>> Menjadi :
>>
>> * 'create folder with name cost center
>> Set ws = ThisWorkbook.Worksheets.Add
>> ws.Name = xcostcenterno
>>
>> * With book.Worksheets("ACTIVITY")
>>
>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>> Columns.Count))).Copy
>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>> datanya ikut ke copy
>>
>> End With
>>
>>
>>
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteAll, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> Jika masih error juga, ubah proses copas menjadi :
>>
>> With book.Worksheets("ACTIVITY")
>>
>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>> Columns.Count))).Copy
>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>> datanya ikut ke copy
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteAll, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>> Columns.Count))).Copy
>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>> datanya ikut ke copy
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> End With
>>
>> Regards.
>> Kid.
>>
>>
>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>
>>> **
>>>
>>>
>>>
>>> Dear para pakar...
>>>
>>> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range dari
>>> file lain spt terlampir.
>>>
>>> paste spesialnya error melulu..
>>>
>>> "pastespecial method of range class failed"
>>>
>>> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
>>> v0.1_test.xlsm
>>>
>>> atas waktu dan effortnya saya ucapkan terimaksih.
>>>
>>>
>>> regards,
>>> Yudha
>>>
>>
>>
>
>
5e.

Re: Copy range dari file lain gagal dihadang Paste Special

Posted by: "Yudha Saptiadi" yudhasaptiadi@gmail.com   yudhasaptiadi

Thu Sep 29, 2011 8:07 pm (PDT)



masih sama mr Kid..

errornya kena disini :

ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0, 0).PasteSpecial
Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Regards,
ys

2011/9/30 Kid Mr. <mr.nmkid@gmail.com>

> **
>
>
> Bagian :
>
> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> Ganti dengan :
> .UsedRange.Copy
>
>
> Kid.
>
> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>
>> **
>>
>>
>> Mr.Kid...
>> sudah di coba dua duanya tp
>> Masih di tendang di paste specialnya
>> apakah karena intersectnya juga yg harus di perbaiki makronya..??
>>
>>
>> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>>
>> **
>>>
>>>
>>> Bagian :
>>> With book.Worksheets("ACTIVITY")
>>>
>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>> Columns.Count))).Copy
>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>>> datanya ikut ke copy
>>>
>>> End With
>>>
>>> * 'create folder with name cost center
>>> Set ws = ThisWorkbook.Worksheets.Add
>>> ws.Name = xcostcenterno*
>>>
>>>
>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>
>>> Letakkan yang biru di atas With book.blah
>>> Menjadi :
>>>
>>> * 'create folder with name cost center
>>> Set ws = ThisWorkbook.Worksheets.Add
>>> ws.Name = xcostcenterno
>>>
>>> * With book.Worksheets("ACTIVITY")
>>>
>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>> Columns.Count))).Copy
>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>>> datanya ikut ke copy
>>>
>>> End With
>>>
>>>
>>>
>>>
>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>
>>> Jika masih error juga, ubah proses copas menjadi :
>>>
>>> With book.Worksheets("ACTIVITY")
>>>
>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>> Columns.Count))).Copy
>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>>> datanya ikut ke copy
>>>
>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>
>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>> Columns.Count))).Copy
>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>>> datanya ikut ke copy
>>>
>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>
>>> End With
>>>
>>> Regards.
>>> Kid.
>>>
>>>
>>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>>
>>>> **
>>>>
>>>>
>>>>
>>>> Dear para pakar...
>>>>
>>>> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range dari
>>>> file lain spt terlampir.
>>>>
>>>> paste spesialnya error melulu..
>>>>
>>>> "pastespecial method of range class failed"
>>>>
>>>> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
>>>> v0.1_test.xlsm
>>>>
>>>> atas waktu dan effortnya saya ucapkan terimaksih.
>>>>
>>>>
>>>> regards,
>>>> Yudha
>>>>
>>>
>>>
>>
>
>
5f.

Re: Copy range dari file lain gagal dihadang Paste Special

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 8:24 pm (PDT)



Setelah dicoba beberapa hal sebelumnya, hasilnya adalah tidak ada masalah
yang timbul.
Jika ditempat anda bermasalah, maka coba ubah blok :

With book.Worksheets("ACTIVITY")

'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
.usedrange.copy

ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
.usedrange.copy
ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End With

menjadi :

With book.Worksheets("ACTIVITY")

.usedrange.copy ws.Range("A1")

.usedrange.copy
ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

End With

Bila perlu, copas script hasil pengubahan anda untuk prosedur tersebut ke
body email.

Kid.

2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>

> **
>
>
> masih sama mr Kid..
>
> errornya kena disini :
>
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0, 0).PasteSpecial
> Paste:=xlPasteAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> Regards,
> ys
>
>
> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>
>> **
>>
>>
>> Bagian :
>>
>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>> Columns.Count))).Copy
>> Ganti dengan :
>> .UsedRange.Copy
>>
>>
>> Kid.
>>
>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>
>>> **
>>>
>>>
>>> Mr.Kid...
>>> sudah di coba dua duanya tp
>>> Masih di tendang di paste specialnya
>>> apakah karena intersectnya juga yg harus di perbaiki makronya..??
>>>
>>>
>>> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>>>
>>> **
>>>>
>>>>
>>>> Bagian :
>>>> With book.Worksheets("ACTIVITY")
>>>>
>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>> Columns.Count))).Copy
>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>> judul datanya ikut ke copy
>>>>
>>>> End With
>>>>
>>>> * 'create folder with name cost center
>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>> ws.Name = xcostcenterno*
>>>>
>>>>
>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>
>>>> Letakkan yang biru di atas With book.blah
>>>> Menjadi :
>>>>
>>>> * 'create folder with name cost center
>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>> ws.Name = xcostcenterno
>>>>
>>>> * With book.Worksheets("ACTIVITY")
>>>>
>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>> Columns.Count))).Copy
>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>> judul datanya ikut ke copy
>>>>
>>>> End With
>>>>
>>>>
>>>>
>>>>
>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>
>>>> Jika masih error juga, ubah proses copas menjadi :
>>>>
>>>> With book.Worksheets("ACTIVITY")
>>>>
>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>> Columns.Count))).Copy
>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>> judul datanya ikut ke copy
>>>>
>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>
>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>> Columns.Count))).Copy
>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>> judul datanya ikut ke copy
>>>>
>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>
>>>> End With
>>>>
>>>> Regards.
>>>> Kid.
>>>>
>>>>
>>>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>>>
>>>>> **
>>>>>
>>>>>
>>>>>
>>>>> Dear para pakar...
>>>>>
>>>>> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range dari
>>>>> file lain spt terlampir.
>>>>>
>>>>> paste spesialnya error melulu..
>>>>>
>>>>> "pastespecial method of range class failed"
>>>>>
>>>>> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
>>>>> v0.1_test.xlsm
>>>>>
>>>>> atas waktu dan effortnya saya ucapkan terimaksih.
>>>>>
>>>>>
>>>>> regards,
>>>>> Yudha
>>>>>
>>>>
>>>>
>>>
>>
>
>
5g.

Re: Copy range dari file lain gagal dihadang Paste Special

Posted by: "Yudha Saptiadi" yudhasaptiadi@gmail.com   yudhasaptiadi

Thu Sep 29, 2011 9:19 pm (PDT)



Mr Kid,
saya lampirkan pengubahan saya yang terakhir dan masih terhadang di paste
special.
mungkin ada ubahan makronya yg salah posisinya.

regards,
yudha
----------------------------------------------------------

Public Sub OpenFile(strPath As String)

Dim RngRowA As Range, RngRowB As Range
Dim xcostcenterno As String, xcostcentername As String
Dim btn, rght As Long
Dim myLastRow As Long
Dim myLastColumn As Long

Dim xlApp As New Excel.Application
xlApp.Visible = False
Dim book As Excel.Workbook
Set book = xlApp.Workbooks.Open(strPath)

With book.Worksheets("SCOPE")
xcostcenterno = .Cells(1, 2).Value
End With

'create folder with name cost center
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = xcostcenterno

With book.Worksheets("ACTIVITY")

'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
'.UsedRange.Copy

'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteAll, _
' Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
'.UsedRange.Copy

'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteColumnWidths, _
'Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.UsedRange.Copy ws.Range("A1")
.UsedRange.Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

End With

ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 80

book.Close savechanges:=False
'app.Quit
Set app = Nothing

End Sub

2011/9/30 Kid Mr. <mr.nmkid@gmail.com>

> **
>
>
> Setelah dicoba beberapa hal sebelumnya, hasilnya adalah tidak ada masalah
> yang timbul.
> Jika ditempat anda bermasalah, maka coba ubah blok :
>
>
> With book.Worksheets("ACTIVITY")
>
> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
> .usedrange.copy
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteAll, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
> .usedrange.copy
>
> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> End With
>
> menjadi :
>
> With book.Worksheets("ACTIVITY")
>
> .usedrange.copy ws.Range("A1")
>
> .usedrange.copy
> ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
>
> End With
>
> Bila perlu, copas script hasil pengubahan anda untuk prosedur tersebut ke
> body email.
>
>
> Kid.
>
> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>
>> **
>>
>>
>> masih sama mr Kid..
>>
>> errornya kena disini :
>>
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0, 0).PasteSpecial
>> Paste:=xlPasteAll, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> Regards,
>> ys
>>
>>
>> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>>
>>> **
>>>
>>>
>>> Bagian :
>>>
>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>> Columns.Count))).Copy
>>> Ganti dengan :
>>> .UsedRange.Copy
>>>
>>>
>>> Kid.
>>>
>>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>>
>>>> **
>>>>
>>>>
>>>> Mr.Kid...
>>>> sudah di coba dua duanya tp
>>>> Masih di tendang di paste specialnya
>>>> apakah karena intersectnya juga yg harus di perbaiki makronya..??
>>>>
>>>>
>>>> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>>>>
>>>> **
>>>>>
>>>>>
>>>>> Bagian :
>>>>> With book.Worksheets("ACTIVITY")
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> End With
>>>>>
>>>>> * 'create folder with name cost center
>>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>>> ws.Name = xcostcenterno*
>>>>>
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> Letakkan yang biru di atas With book.blah
>>>>> Menjadi :
>>>>>
>>>>> * 'create folder with name cost center
>>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>>> ws.Name = xcostcenterno
>>>>>
>>>>> * With book.Worksheets("ACTIVITY")
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> End With
>>>>>
>>>>>
>>>>>
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> Jika masih error juga, ubah proses copas menjadi :
>>>>>
>>>>> With book.Worksheets("ACTIVITY")
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>> Columns.Count))).Copy
>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>> judul datanya ikut ke copy
>>>>>
>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>
>>>>> End With
>>>>>
>>>>> Regards.
>>>>> Kid.
>>>>>
>>>>>
>>>>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>>>>
>>>>>> **
>>>>>>
>>>>>>
>>>>>>
>>>>>> Dear para pakar...
>>>>>>
>>>>>> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range
>>>>>> dari file lain spt terlampir.
>>>>>>
>>>>>> paste spesialnya error melulu..
>>>>>>
>>>>>> "pastespecial method of range class failed"
>>>>>>
>>>>>> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
>>>>>> v0.1_test.xlsm
>>>>>>
>>>>>> atas waktu dan effortnya saya ucapkan terimaksih.
>>>>>>
>>>>>>
>>>>>> regards,
>>>>>> Yudha
>>>>>>
>>>>>
>>>>>
>>>>
>>>
>>
>
>
5h.

Re: Copy range dari file lain gagal dihadang Paste Special

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 9:32 pm (PDT)



'sepertinya ada hal yang belum terbaca permasalahannya. Mungkin gak ya
karena susunan cell-cell di file Anda.
'Kok dicoba disini oke-oke saja
'coba yang ini
Public Sub OpenFile(strPath As String)

Dim RngRowA As Range, RngRowB As Range
Dim xcostcenterno As String, xcostcentername As String
Dim btn, rght As Long
Dim myLastRow As Long
Dim myLastColumn As Long

'create folder with name cost center
Set ws = ThisWorkbook.Worksheets.Add

'Dim xlApp As New Excel.Application
' xlApp.Visible = False
Dim book As Workbook
Set book = Workbooks.Open(strPath)

With book.Worksheets("SCOPE")
xcostcenterno = .Cells(1, 2).Value
ws.Name = xcostcenterno
End With

With book.Worksheets("ACTIVITY")

'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
'.UsedRange.Copy

'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteAll, _

' Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
Columns.Count))).Copy
'mencari range yang ada datanya dimulai dari cell A1 supaya judul
datanya ikut ke copy
'.UsedRange.Copy

'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
0).PasteSpecial Paste:=xlPasteColumnWidths, _
'Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.UsedRange.Copy ws.Range("A1")
.UsedRange.Copy
ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

book.Close savechanges:=False

ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 80

End With

end sub

Kid.

2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>

> **
>
>
>
> Mr Kid,
> saya lampirkan pengubahan saya yang terakhir dan masih terhadang di paste
> special.
> mungkin ada ubahan makronya yg salah posisinya.
>
> regards,
> yudha
> ----------------------------------------------------------
>
> Public Sub OpenFile(strPath As String)
>
> Dim RngRowA As Range, RngRowB As Range
> Dim xcostcenterno As String, xcostcentername As String
> Dim btn, rght As Long
> Dim myLastRow As Long
> Dim myLastColumn As Long
>
>
>
> Dim xlApp As New Excel.Application
> xlApp.Visible = False
> Dim book As Excel.Workbook
> Set book = xlApp.Workbooks.Open(strPath)
>
> With book.Worksheets("SCOPE")
> xcostcenterno = .Cells(1, 2).Value
>
> End With
>
> 'create folder with name cost center
> Set ws = ThisWorkbook.Worksheets.Add
> ws.Name = xcostcenterno
>
>
> With book.Worksheets("ACTIVITY")
>
> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
> '.UsedRange.Copy
>
> 'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteAll, _
>
> ' Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
> Columns.Count))).Copy
> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
> datanya ikut ke copy
> '.UsedRange.Copy
>
> 'ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>
> 'Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>
>
> .UsedRange.Copy ws.Range("A1")
> .UsedRange.Copy
>
> ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
>
>
>
> End With
>
>
> ActiveWindow.DisplayGridlines = False
> ActiveWindow.Zoom = 80
>
> book.Close savechanges:=False
> 'app.Quit
> Set app = Nothing
>
> End Sub
>
>
> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>
> **
>>
>>
>> Setelah dicoba beberapa hal sebelumnya, hasilnya adalah tidak ada masalah
>> yang timbul.
>> Jika ditempat anda bermasalah, maka coba ubah blok :
>>
>>
>> With book.Worksheets("ACTIVITY")
>>
>> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>> Columns.Count))).Copy
>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>> datanya ikut ke copy
>> .usedrange.copy
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteAll, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> 'xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>> Columns.Count))).Copy
>> 'mencari range yang ada datanya dimulai dari cell A1 supaya judul
>> datanya ikut ke copy
>> .usedrange.copy
>>
>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>
>> End With
>>
>> menjadi :
>>
>> With book.Worksheets("ACTIVITY")
>>
>> .usedrange.copy ws.Range("A1")
>>
>> .usedrange.copy
>> ws.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
>>
>> End With
>>
>> Bila perlu, copas script hasil pengubahan anda untuk prosedur tersebut ke
>> body email.
>>
>>
>> Kid.
>>
>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>
>>> **
>>>
>>>
>>> masih sama mr Kid..
>>>
>>> errornya kena disini :
>>>
>>>
>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>
>>> Regards,
>>> ys
>>>
>>>
>>> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>>>
>>>> **
>>>>
>>>>
>>>> Bagian :
>>>>
>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>> Columns.Count))).Copy
>>>> Ganti dengan :
>>>> .UsedRange.Copy
>>>>
>>>>
>>>> Kid.
>>>>
>>>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>>>
>>>>> **
>>>>>
>>>>>
>>>>> Mr.Kid...
>>>>> sudah di coba dua duanya tp
>>>>> Masih di tendang di paste specialnya
>>>>> apakah karena intersectnya juga yg harus di perbaiki makronya..??
>>>>>
>>>>>
>>>>> 2011/9/30 Kid Mr. <mr.nmkid@gmail.com>
>>>>>
>>>>> **
>>>>>>
>>>>>>
>>>>>> Bagian :
>>>>>> With book.Worksheets("ACTIVITY")
>>>>>>
>>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>>> Columns.Count))).Copy
>>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>>> judul datanya ikut ke copy
>>>>>>
>>>>>> End With
>>>>>>
>>>>>> * 'create folder with name cost center
>>>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>>>> ws.Name = xcostcenterno*
>>>>>>
>>>>>>
>>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>>
>>>>>> Letakkan yang biru di atas With book.blah
>>>>>> Menjadi :
>>>>>>
>>>>>> * 'create folder with name cost center
>>>>>> Set ws = ThisWorkbook.Worksheets.Add
>>>>>> ws.Name = xcostcenterno
>>>>>>
>>>>>> * With book.Worksheets("ACTIVITY")
>>>>>>
>>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>>> Columns.Count))).Copy
>>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>>> judul datanya ikut ke copy
>>>>>>
>>>>>> End With
>>>>>>
>>>>>>
>>>>>>
>>>>>>
>>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>>
>>>>>> Jika masih error juga, ubah proses copas menjadi :
>>>>>>
>>>>>> With book.Worksheets("ACTIVITY")
>>>>>>
>>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>>> Columns.Count))).Copy
>>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>>> judul datanya ikut ke copy
>>>>>>
>>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>>> 0).PasteSpecial Paste:=xlPasteAll, _
>>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>>
>>>>>> xlApp.Intersect(.UsedRange, .Range("A1", .Cells(Rows.Count,
>>>>>> Columns.Count))).Copy
>>>>>> 'mencari range yang ada datanya dimulai dari cell A1 supaya
>>>>>> judul datanya ikut ke copy
>>>>>>
>>>>>> ws.Range("A" & ws.Range("A65536").End(xlUp).Row).Offset(0,
>>>>>> 0).PasteSpecial Paste:=xlPasteColumnWidths, _
>>>>>> Operation:=xlNone, SkipBlanks:=False, Transpose:=False
>>>>>>
>>>>>> End With
>>>>>>
>>>>>> Regards.
>>>>>> Kid.
>>>>>>
>>>>>>
>>>>>> 2011/9/30 Yudha Saptiadi <yudhasaptiadi@gmail.com>
>>>>>>
>>>>>>> **
>>>>>>>
>>>>>>>
>>>>>>>
>>>>>>> Dear para pakar...
>>>>>>>
>>>>>>> mohon bantuannnya yaaa...memperbaiki macronya pada saat copy range
>>>>>>> dari file lain spt terlampir.
>>>>>>>
>>>>>>> paste spesialnya error melulu..
>>>>>>>
>>>>>>> "pastespecial method of range class failed"
>>>>>>>
>>>>>>> Notes: untuk mengambil datanya gunakan file: __Konsolidasi Activity
>>>>>>> v0.1_test.xlsm
>>>>>>>
>>>>>>> atas waktu dan effortnya saya ucapkan terimaksih.
>>>>>>>
>>>>>>>
>>>>>>> regards,
>>>>>>> Yudha
>>>>>>>
>>>>>>
>>>>>>
>>>>>
>>>>
>>>
>>
>
>
6.1.

Re: Update Tabel dari sheet lain...

Posted by: "jkssxls Sudarsono" jkssxls@hotmail.com   jkssbma

Thu Sep 29, 2011 8:29 pm (PDT)




Karena penggunaan For Each menelusuri setiap sel ( bukan tiap baris data ) , maka koding perlu diubah menjadi : Public Function JoinPakeKoleksi_m(rngUpdateKolomPertama As Range, rngDataLamaKolomPertama As Range) As Variant
Dim col As Collection 'selalu base 1
Dim rng As Range
Dim lRecs As Long
Dim sItem() As String 'vb6 menggunakan default base 0
Dim vRes As Variant
On Error Resume Next
Set col = New Collection
'mulai dari updater
Dim barissekarang As Long
Dim scItem As String
Dim scKey As String
Dim kolomkey As Integer
Dim kolompertama As Integer
'=========' data updater C B E ' data lama A B C D ' karena key berdasarkan header HD2 , maka C dari data lama menimbulkan error ( duplicate key , err.number = 475 )' dgn trik on error resume , maka perintah dilanjutkan ke perintah baris berikutnya
kolomkey = 2 ' A B C D E ( HD2 )'
scItem = "" 'tampung untuk item
scKey = "" 'tampung untuk key
'---
kolompertama = rngUpdateKolomPertama.Column
barissekarang = rngUpdateKolomPertama.Row
For Each rng In rngUpdateKolomPertama
If rng.Row = barissekarang Then
' simpan sampai kolom terakhir dlm baris yg sama
scItem = scItem & "|" & rng.Value
If (rng.Column - kolompertama + 1 = kolomkey) Then
scKey = rng.Value
End If
Else
' jika baris berikutnya
scItem = Mid(scItem, 2)
col.Add Item:=scItem, Key:=scKey' jika ada duplikat key maka dilanjutkan ke ScItem = ....
scItem = "|" & rng.Value
barissekarang = rng.Row
End If
Next rng
'-- baris terakhir ikut disimpan
scItem = Mid(scItem, 2)
col.Add Item:=scItem, Key:=scKey' jika ada duplikat key maka dilanjutkan ke ScItem = .....
'-----------------
'ikuti dengan data lama
scItem = ""
scKey = ""
kolompertama = rngDataLamaKolomPertama.Column
barissekarang = rngDataLamaKolomPertama.Row
'--
For Each rng In rngDataLamaKolomPertama
If rng.Row = barissekarang Then
' simpan sampai kolom terakhir dlm baris yg sama
scItem = scItem & "|" & rng.Value
If (rng.Column - kolompertama + 1 = kolomkey) Then
scKey = rng.Value
End If
Else
' jika baris berikutnya
scItem = Mid(scItem, 2)
col.Add Item:=scItem, Key:=scKey' jika ada duplikat key maka dilanjutkan ke ScItem = .....
scItem = "|" & rng.Value
barissekarang = rng.Row
End If
Next rng
'-- baris terakhir ikut disimpan
scItem = Mid(scItem, 2)
col.Add Item:=scItem, Key:=scKey' jika ada duplikat key maka dilanjutkan ke lRecs = col.Count
'=== jumlah baris data
lRecs = col.Count
ReDim vRes(1 To lRecs, 1 To 3) As Variant
Dim myitem As String
For lRecs = 1 To col.Count' pisahkan item menjadi array
sItem = Split(col(lRecs), "|")
vRes(lRecs, 1) = sItem(0)
vRes(lRecs, 2) = sItem(1)
vRes(lRecs, 3) = sItem(2)
Next lRecs
JoinPakeKoleksi_m = vRes
End Function
catatan : Sekali lagi , terima kasih Mr Kid atas teknik collection , menambah wawasan baru bagi saya ( mungkin juga bagi be-Excel-er lainnnya )
To: belajar-excel@yahoogroups.com
From: mr.nmkid@gmail.com
Date: Thu, 29 Sep 2011 16:38:53 +0700
Subject: Re: [belajar-excel] Update Tabel dari sheet lain...

Oke. Bebas deh mau diapakan saja.

Yang jelas :
Object collection bisa mengurangi beban cek item apakah sudah ada atau belum yang biasanya di loop sendiri dengan for next atau do loop.
Object ini cocok untuk data yang unique komposit key nya.

Pada proses update data, dahulukan sisi data updater, baru diikuti dengan data lama yang ada di database.
Inti dari proses update data adalah pada bagian :
col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" &
rng.Offset(, 2).Value , rng.Value & "|" & rng.Offset(, 1).Value
Yang biru adalah gabungan nilai data seluruh kolom
Yang hijau adalah komposit key, jadi bebas tergantung kebutuhan, keynya mau pake yang mana saja dan berapa saja.

Jika komposit key telah terdaftar dalam koleksi, maka akan muncul error value. Itu sebabnya ada baris error trap dengan on error resume next di atas sana.

Karakter | digunakan dengan asumsi tidak pernah digunakan sebagai isi dari nilai-nilai disetiap kolom. Jika ternyata dipakai, maka gunakan karakter lain yang tidak dipakai di semua kolom.

Untuk penerapan di selain di Excel, waspadai datatype. Karena hasil Split adalah string. Di Excel, ada fasilitas konversi oleh excelnya sendiri ketika string angka masuk ke cell.

Kid.

2011/9/29 jkssxls Sudarsono <jkssxls@hotmail.com>

saya koreksi ya Mr Kids :
col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" & rng.Offset(, 2).Value, rng.Value & "|" & rng.Offset(, 1).Value
menjadi :
col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" & rng.Offset(, 2).Value, rng.Offset(, 1).Value

dimana key menggunakan kolom yang berisi A,B,C,D,E ( kolom ke-2 atau relatif satu kolom kekanan )
sehingga lengkapnya ( saya hilangkan karena hasil masih belum tepat ) :
To: belajar-excel@yahoogroups.com

From: mr.nmkid@gmail.com
Date: Thu, 29 Sep 2011 14:44:37 +0700
Subject: Re: [belajar-excel] Update Tabel dari sheet lain...

Coba juga menggunakan object collection untuk join table

Public Function JoinPakeKoleksi(rngUpdateKolomPertama As Range, rngDataLamaKolomPertama As Range) As Variant
Dim col As Collection 'selalu base 1

Dim rng As Range
Dim lRecs As Long
Dim sItem() As String 'vb6 menggunakan default base 0
Dim vRes As Variant

On Error Resume Next
Set col = New Collection
'mulai dari updater

For Each rng In rngUpdateKolomPertama
If LenB(rng.Value) <> 0 Then
col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" & rng.Offset(, 2).Value, _

rng.Value & "|" & rng.Offset(, 1).Value
End If
Next rng

'ikuti dengan data lama
For Each rng In rngDataLamaKolomPertama
If LenB(rng.Value) <> 0 Then

col.Add rng.Value & "|" & rng.Offset(, 1).Value & "|" & rng.Offset(, 2).Value, _
rng.Value & "|" & rng.Offset(, 1).Value
End If

Next rng
lRecs = col.Count
ReDim vRes(1 To lRecs, 1 To 3) As Variant
For lRecs = 1 To col.Count
sItem = Split(col(lRecs), "|")
vRes(lRecs, 1) = sItem(0)
vRes(lRecs, 2) = sItem(1)

vRes(lRecs, 3) = sItem(2)
Next lRecs

JoinPakeKoleksi = vRes
End Function
'Mungkin perlu dicoba untuk record update yang banyak dan record data yang juga banyak.

Ingin di-sort ?

buat fungsi sorting yang inputnya berupa array, agar hasil fungsi di atas bisa menjadi input parameter untuk fungsi sorting tersebut.

Regards.
Kid.

2011/9/29 jkssxls Sudarsono <jkssxls@hotmail.com>

saya modif fungsi join menjadi join_m
Private Function JOIN_m(L01 As Range, L02 As Range)
'=== siti Vi : Fungsi JOIN : menggabung dua List
' modified by Haps: 29 sep 2011
' tiap list berisi 3 kolom, Uniq pada Kolom 1 (ID)

'=================================================
Dim ArS As String, ArUp(), Tmp
Dim i As Long, j As Long, p As Long, u As Long
Dim kolomkey As Integer
kolomkey = 2
' menyusun 3 array ex tabel data

ArS = "|"
ReDim Preserve ArUp(1 To 3, 1 To L01.Rows.Count)
For i = 1 To L01.Rows.Count
'isi string dari kolom H1 ( berisi A,B,C,D )
ArS = ArS & L01(i, kolomkey) & "|"

ArUp(1, i) = L01(i, 1)
ArUp(2, i) = L01(i, 2)
ArUp(3, i) = L01(i, 3)
Next i
' array tabel diperbesar dengan data di L02 (update)
' j = UBound(ArUp)
' ambil banyaknya data di dimensi ke-2 : A B C D

j = UBound(ArUp, 2)
For i = 1 To L02.Rows.Count
' jika ID di L02 belum ada di L01.. maka..
If InStr(1, ArS, "|" & L02(i, kolomkey) & "|") = 0 Then
' jika data di L02 tak ada di ArS

ArS = ArS & L02(i, kolomkey) & "|"
j = j + 1: ReDim Preserve ArUp(1 To 3, 1 To j)
ArUp(1, j) = L02(i, 1)
ArUp(2, j) = L02(i, 2)
ArUp(3, j) = L02(i, 3)

Else ' jika ID di list L02 sudah ada di L01 (kembar)
' Nilainya H2-nya diambilkan dari L02 (data pengUpdate)
For p = 1 To j
If L02(i, kolomkey) = ArUp(kolomkey, p) Then

' ganti data pada ArUp dgn data di L02 hanya index ke-3
ArUp(3, p) = L02(i, 3)
Exit For
End If
Next p
End If
Next i
' bubble sort, mengurutkan hasil Array (sort by ID)

For i = LBound(ArUp) To UBound(ArUp) - 1
For u = LBound(ArUp) To UBound(ArUp) - 1
If ArUp(kolomkey, u) > ArUp(kolomkey, u + 1) Then
Tmp = ArUp(1, u): ArUp(1, u) = ArUp(1, u + 1): ArUp(1, u + 1) = Tmp

Tmp = ArUp(2, u): ArUp(2, u) = ArUp(2, u + 1): ArUp(2, u + 1) = Tmp
Tmp = ArUp(3, u): ArUp(3, u) = ArUp(3, u + 1): ArUp(3, u + 1) = Tmp
End If
Next u
Next i
' variable Join di-isi array ArUp (2 dimensi (3 kol * n row)

JOIN_m = ArUp
End Function

To: belajar-excel@yahoogroups.com
From: jkssxls@hotmail.com

Date: Thu, 29 Sep 2011 05:13:38 +0000
Subject: RE: [belajar-excel] Update Tabel dari sheet lain...

data utama

ID
H1
H2


1
A
100


2
B
125


3
C
10


4
D
5


data updater

ID
H1
H2


1
C
200


2
B
0


5
E
15


data hasil update :

ID
H1
H2


1
A
200


2
B
0


3
C
10


4
D
5


5
E
15


seharusnya :

ID
H1
H2


1

A
100


2
B
0


3
C
200


4
D
5


5
E
15


hal ini karena yg menjadi pembanding adalah index ke -1 ( kolom Id ) , sebaiknya index -2 ( kolom H1 ).
Maaf sedikit mengoreksi .. tak apa -apa , kan....
To: belajar-excel@yahoogroups.com

From: jkssxls@hotmail.com
Date: Thu, 29 Sep 2011 04:42:28 +0000
Subject: RE: [belajar-excel] Update Tabel dari sheet lain...

Mbak Haps , saya sudah coba , ada sedikit yang saya koreksi pada fungsi join :
j = UBound(ArUp) akan selalu menghasilkan 3
di koreksi menjadi
j = UBound(ArUp, 2) akan menghasilkan banyaknya data di range "data" ( worksheet "data" )

Tetapi saya berterima kasih atas fungsi Updatable dan join hasil modif nya

To: belajar-excel@yahoogroups.com
From: hapsari.stlizbeth@gmail.com

Date: Thu, 29 Sep 2011 04:30:15 +0700
Subject: Re: [belajar-excel] Update Tabel dari sheet lain...

Fungsi JOIN telah dimodifikasi (lihat module), agar dapat menampung tabel 2 dimensi) 3 kolomKemudian Fungsi tsb dimanfaatkan untuk mengUpdate tabel data dengan prosedur Sub.

Sudah dicoba sepertinya berhasil, hanya saja listing vba-code nya jadi kepanjangan...

Sub UpdateTable()
' Haps // 28 sept 2011 '---------------------
Dim DatRng As Range, NewRng As Range, ArNew, r As Long

' init: Tabel Data (tanpa headernya)

Set DatRng = Sheets("Data").Cells(1).CurrentRegion.Offset(1, 0) Set DatRng = DatRng.Resize(DatRng.Rows.Count - 1, DatRng.Columns.Count)

' init: Tabel pengUpdate (tanpa header)

Set NewRng = Sheets("Update").Cells(1).CurrentRegion.Offset(1, 0) Set NewRng = NewRng.Resize(NewRng.Rows.Count - 1, NewRng.Columns.Count)

' -- membuat Array (3 kolom * n Baris) dibantu fungsi JOIN

ArNew = JOIN(DatRng, NewRng)
' -- hapus isi tabel data

DatRng.ClearContents
' -- tabel data (yg baru dikosongkan) diupdate dgn data dari Array

For r = 1 To UBound(ArNew, 2) DatRng(r, 1) = ArNew(1, r)

DatRng(r, 2) = ArNew(2, r) DatRng(r, 3) = ArNew(3, r)

Next r
DatRng.Parent.Activate MsgBox "Selesai", vbInformation, ThisWorkbook.Name

End Sub

cmiiww

2011/9/28 Haps <hapsari.stlizbeth@gmail.com>

dulu, sudah lupa bulan / tahunnya, mba siti pernah membuat UDF Join

dua list jika di JOIN, berarti dua lis akan digabung, tetapi data kembar hanya dimunculkan 1 kali

jika perlu hasil JOIN bisa diurutkan (sorted)

sementara belum sempat membuat /memodifikasi makro menjadi khusus untuk keperluan

"sambil JOIN (kolom 1) juga sambil SUMIF (kolom 2)"
saya yakin mas zainul ulum bisa memodifikasi makro tsb agar dapat mengerjakan keperluan

yg diajukan tsb, mungkin berupa prosedur Sub bukan FUnction lebih cuocokk....
ini sudah seijin mbak siti contoh UDF JOINT dilampirkan di sini

'---text / VBA codeing UDF Join

Function JOIN(List1 As Range, List2 As Range, Optional N As Long = 0, _

Optional Urutkan As Boolean = False)
'----- End Function

2011/9/28 zainul ulum <<yahoo>> <zainul_ulum@yahoo.com>

Be-exceler,

Misalnya saya mempunyai table di [sheet 1] dan [Sheet 2].

Table di [sheet 1] akan diupdate berdasarkan record dari [Sheet 2].

Bagaimanakah codenya (macro) agar record di [sheet 1] bisa terupdate

berdasarkan perubahan di [Sheet 2]?

Terimakasih,

-zainul-









7.

Buat Login Pada Excel

Posted by: "Henry Sitohang" henrysitohang@yahoo.com   henrysitohang

Thu Sep 29, 2011 8:36 pm (PDT)



Para Exceler,
Mohon bantuannya atas masalah saya di bawah ini:
1. Bagaimana formula untuk buat login (sheet terlampir)
2. Bagaimana formula untuk mengisi bulan dan tahun pada lembar SPTnya (otomatis terisi pada saat saya hanya mengisi pada isian  di lembar "Menu")

Thanks berat atas bantuannya

 

________________________________
Henry Norris Sitohang
Mail : henrysitohang@yahoo.com
          henrysitohang@ovi.com
Mobile : 081384056896

--Mods--
File lampiran dihilangkan karena melebihi 250KB. Kita tunggu file baru dari Pak Henry yang memenuhi peraturan milis <250KB.

8.

Macro passkey document & disabled macro

Posted by: "isti_astro" istiastro@gmail.com   isti_astro

Thu Sep 29, 2011 9:02 pm (PDT)



Dear Para Master,*

*Saya mencoba membuat security file sederhana (biar tidak dapat di copy
paste) dengan menggunakan macro dan sudah sukses file tidak dapat terbuka
tanpa adanya file tambahan dalam satu folder (pass.txt). Namun masalahnya
adalah di Excel 2003 ketika membuka file akan ada option untuk disable atau
enable macro, jika di-disable...maka file tersebut akan tetap dapat terbuka
dan macro yang sudah dibuat tidak akan berjalan.

Pertanyaannya :
1. Adakah cara agar jika macro di-disable file tidak akan dapat terbuka atau
tetap close & kalau bisa tanpa harus menambah fungsi baru.
2. Coding macro agar sheet2 & sheet3 tiga ter-hidden dan hanya sheet1 yang
tampil.

Terima kasih banyak atas bantuannya

regards,
Isti *

***

** **

--
Sewa ruang kantor murah mulai dari 200 rb/bulan klik http://bit.ly/noQL87
Ingin jadi technopreneur silahkan klik http://bit.ly/d6edBw

Mau nomor 1 di Google klik http://bit.ly/nnEDOp
Reviews, Tips & Trick : http://istiastro.blogspot.com

----------

Silahkan buka file excel...
9a.

Bls: [belajar-excel] Chart dinamis, format conditional & row dinamis

Posted by: "Dewan Deya" dwanxls@yahoo.co.id   dwanxls

Thu Sep 29, 2011 9:20 pm (PDT)



Tks Mr. Kid atas jawaban masalah saya ini, dan sangat membantu sekali.Maaf baru reply.

Ada yang ingin saya tanyakan, kenapa jika di tabel BEFORE SORT (sheet report_chart), jika angka nya di isi negatif, maka hasil di tabel AFTER SORT hasilnya #REF, bukan angka negatif tsb.

Tks sebelumnya.

________________________________
Dari: Kid Mr. <mr.nmkid@gmail.com>
Kepada: belajar-excel@yahoogroups.com
Dikirim: Kamis, 22 September 2011 15:19
Judul: Re: [belajar-excel] Chart dinamis, format conditional & row dinamis

 
Dear Deya,

No. 1 :
Pakai Conditional formatting yang berdasarkan opsi Use formula (xl2007) atau Formula Is (xl2003)
Isi formulanya : (misal data di nama negara di cell C3)
=$C3="Indonesia"
kemudian atur formatnya.

No. 2 :
Chart adalah sebuah laporan. Sebaiknya data source untuk chart diambil langsung dari raw data.
Salah satu caranya adalah : (untuk 2 warna saja)
Membuat kolom Indonesia dan Non Indonesia sebagai 2 series data chart.
Nilai dikolom Indonesia diisi ketika negaranya Indonesia, selainnya diisi 0 atau error value atau blank.
Buat chart dengan 2 series berdasar 2 kolom tadi (setiap seriesnya dari masing-maing kolom tadi)
Pindahkan series Indonesia ke Secondary axis
Atur tampilannya.

No. 3 :
Rekap adalah sebuah laporan. Semua nilai adalah hasil proses terhadap nilai-nilai di raw data.
Fitur Pivot Table biasanya memberi kemudahan untuk menyusun rekap sederhana. Terutama untuk eksplorasi data.

Regards.
Kid.

2011/9/22 Dewan Deya <dwanxls@yahoo.co.id>


>Dear para pakar excel,
>
>
>
>Saya mempunyai data & chart bar (terlampir).
>Setelah di sort peringkat Indonesia bisa menduduki ranking tertentu, dan besok nya bisa berubah menjadi peringkat yang berbeda dibandingkan hari sebelumnya.
>
>
>Pertanyaan saya:
>1. Untuk data hasil sort, kata INDONESIA format warna font nya bisa secara otomatis berwarna merah, saya gunakan format conditional. Jadi jika menemui kata INDONESIA maka secara otomatis akan kata tersebut akan berwarna merah. Untuk angka nya bagaimana ya supaya secara otomatis juga berwarna merah?.
>
>
>2. Untuk chart. Bagaimana CARA OTOMATIS agar chart Indonesia selalu berwarna merah, mengingat posisi peringkatnya selalu berubah ubah setiap hari.
>
>
>3. Untuk data sebelum sort. Data dari tabel sebelum sort akan di copy  (copy transpose) kan ke sheet rekap. Tadinya saya sudah buat macro nya, cuma kendalanya row (baris) nya kan bersifat dinamis, sesuai dengan tanggalnya. Ada cara laen?.
>
>
>Tks sebelumnya.
>
>
>
>
>
>
>
>
>
>
>
>

9b.

Re: Chart dinamis, format conditional & row dinamis

Posted by: "Kid Mr." mr.nmkid@gmail.com   nmkid.family@ymail.com

Thu Sep 29, 2011 9:41 pm (PDT)



Ganti array formula di cell A3 menjadi :
=SMALL(--(INT($F$19:$F$27*1000)&(ROW($F$19:$F$27)-ROW($F$18))/100),ROW(1:1))
lalu copy ke bawah.

#REF muncul karena index baris yang disimpan di hasil array formula kolom A
(sebelum diperbaiki) melebihi jumlah range yang dirujuk oleh index.
Jadi, yang tadinya menggunakan + maka sekarang menjadi menggunakan &
(concatenate)
Hasil concatenate adalah bertipe string (text) oleh sebab itu harus di
konversi menjadi numerik lagi dengan --( )
Jadideh array formulanya berwujud seperti diatas itu.

Kid.

2011/9/30 Dewan Deya <dwanxls@yahoo.co.id>

> **
>
>
> Tks Mr. Kid atas jawaban masalah saya ini, dan sangat membantu sekali.Maaf
> baru reply.
>
> Ada yang ingin saya tanyakan, kenapa jika di tabel BEFORE SORT (sheet
> report_chart), jika angka nya di isi negatif, maka hasil di tabel AFTER SORT
> hasilnya #REF, bukan angka negatif tsb.
>
> Tks sebelumnya.
>
>
>
> ------------------------------
> *Dari:* Kid Mr. <mr.nmkid@gmail.com>
> *Kepada:* belajar-excel@yahoogroups.com
> *Dikirim:* Kamis, 22 September 2011 15:19
> *Judul:* Re: [belajar-excel] Chart dinamis, format conditional & row
> dinamis
>
>
> Dear Deya,
>
> No. 1 :
> Pakai Conditional formatting yang berdasarkan opsi Use formula (xl2007)
> atau Formula Is (xl2003)
> Isi formulanya : (misal data di nama negara di cell C3)
> =$C3="Indonesia"
> kemudian atur formatnya.
>
> No. 2 :
> Chart adalah sebuah laporan. Sebaiknya data source untuk chart diambil
> langsung dari raw data.
> Salah satu caranya adalah : (untuk 2 warna saja)
> Membuat kolom Indonesia dan Non Indonesia sebagai 2 series data chart.
> Nilai dikolom Indonesia diisi ketika negaranya Indonesia, selainnya diisi 0
> atau error value atau blank.
> Buat chart dengan 2 series berdasar 2 kolom tadi (setiap seriesnya dari
> masing-maing kolom tadi)
> Pindahkan series Indonesia ke Secondary axis
> Atur tampilannya.
>
> No. 3 :
> Rekap adalah sebuah laporan. Semua nilai adalah hasil proses terhadap
> nilai-nilai di raw data.
> Fitur Pivot Table biasanya memberi kemudahan untuk menyusun rekap
> sederhana. Terutama untuk eksplorasi data.
>
> Regards.
> Kid.
>
> 2011/9/22 Dewan Deya <dwanxls@yahoo.co.id>
>
> **
>
> Dear para pakar excel,
>
> Saya mempunyai data & chart bar (terlampir).
> Setelah di sort peringkat Indonesia bisa menduduki ranking tertentu, dan
> besok nya bisa berubah menjadi peringkat yang berbeda dibandingkan hari
> sebelumnya.
>
> Pertanyaan saya:
> 1. Untuk data hasil sort, kata INDONESIA format warna font nya bisa secara
> otomatis berwarna merah, saya gunakan format conditional. Jadi jika menemui
> kata INDONESIA maka secara otomatis akan kata tersebut akan berwarna merah.
> Untuk angka nya bagaimana ya supaya secara otomatis juga berwarna merah?.
>
> 2. Untuk chart. Bagaimana CARA OTOMATIS agar chart Indonesia selalu
> berwarna merah, mengingat posisi peringkatnya selalu berubah ubah setiap
> hari.
>
> 3. Untuk data sebelum sort. Data dari tabel sebelum sort akan di copy
> (copy transpose) kan ke sheet rekap. Tadinya saya sudah buat macro nya, cuma
> kendalanya row (baris) nya kan bersifat dinamis, sesuai dengan tanggalnya.
> Ada cara laen?.
>
> Tks sebelumnya.
>
>
>
>
>
>
>
>
>
>
>
10.

Pembalian dana pst batal

Posted by: "Yusril Ramadani" yusrilramadani@gmail.com   yusril_rmd

Thu Sep 29, 2011 9:41 pm (PDT)



Dear para pakar

bisa dibantu file terlampir dg case sbb :
file terlampir adalah untuk simulasi pengembalian dana jika ada pembatalan

dengan 2 pendekatan

perhitungan dg pendekatan harian = 70% x Dana yg dibayar x dengan
masa yang tersisa per cara bayar Bilangan pembagi

Tahunan 365

Semesteran 183

Quartalan 92 (4 x setahun)

perhitungan dg pendekatan Bulanan
= Faktor (per cara bayar) ditabel x Dana yg dibayar

Terima kasih sebelumnya

Salam
YR
11.

perbandingan 2 kolom 2 kriteria

Posted by: "Jonathan Susanto" jonathan.susanto@gmail.com   jonathan_susanto

Thu Sep 29, 2011 10:51 pm (PDT)



Dear Be-exceller,

Tolong bantu solve,

perbandingan 2 daftar data dengan 2 kriteria.

Untuk lebih jelas, liat sample.

Thanks
Jonathan
Recent Activity
Visit Your Group
Yahoo! Groups

Small Business Group

Improve your business

by community exchange

Yahoo! Finance

It's Now Personal

Guides, news,

advice & more.

Dog Fanatics

on Yahoo! Groups

Find people who are

crazy about dogs.

Need to Reply?

Click one of the "Reply" links to respond to a specific message in the Daily Digest.

Create New Topic | Visit Your Group on the Web
---------------------------------------------------------------------
bergabung ke milis (subscribe), kirim mail kosong ke:
belajar-excel-subscribe@yahoogroups.com

posting ke milis, kirimkan ke:
belajar-excel@yahoogroups.com

berkunjung ke web milis
http://tech.groups.yahoo.com/group/belajar-excel/messages

melihat file archive / mendownload lampiran
http://www.mail-archive.com/belajar-excel@yahoogroups.com/
atau (sejak 25-Apr-2011) bisa juga di :
http://milis-belajar-excel.1048464.n5.nabble.com/

menghubungi moderators & owners: belajar-excel-owner@yahoogroups.com

keluar dari membership milis (UnSubscribe):
kirim mail kosong ke  belajar-excel-unsubscribe@yahoogroups.com
---------------------------------------------------------------------
MARKETPLACE

Stay on top of your group activity without leaving the page you're on - Get the Yahoo! Toolbar now.


Stay on top of your group activity without leaving the page you're on - Get the Yahoo! Toolbar now.

Tidak ada komentar:

Posting Komentar