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, xlPasteSpecialOpera tionAdd
.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. >wrote:id
> **
>
>
> 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( xlCellTypeVisibl e).Copy
rngDT2.Offset(lRec).PasteSpeci al xlPasteValues, SkipBlanks:= True
lRec = rngDT1.Resize(, 1).SpecialCells( xlCellTypeVisibl e).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:=xlPasteColum nWidths
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:=xlPasteColum nWidths
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:=xlPasteColum nWidths
>
> 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:=xlPasteColum nWidths
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:=xlPasteColum nWidths
>
>
>
> 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:=xlPasteColum nWidths
>>
>> 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(rngUpdateKolom Pertama As Range, rngDataLamaKolomPer tama 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(rngUpdateKolomPe rtama As Range, rngDataLamaKolomPer tama 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
Need to Reply?
Click one of the "Reply" links to respond to a specific message in the Daily Digest.
---------------------------------------------------------------------
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
---------------------------------------------------------------------
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
Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Individual | Switch format to Traditional
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe
Tidak ada komentar:
Posting Komentar