Coba script berikut : (letakkan pada event yang Anda gunakan)
Dim rng As Range 'range yang diproses
Dim vFile As Variant 'nama workbook tujuan
Dim sMsg As String 'wadah pesan ke user
Dim wbkApp As Workbook 'workbook pemanggil
Dim wbk As Workbook 'workbook tujuan
Dim sht As Worksheet 'sheet tujuan
Dim shtNew As Worksheet 'sheet baru
Dim shtMain As Worksheet
Dim lSht As Long 'indeks sheet
Application.ScreenUpdating = False
On Error Resume Next 'trap error agar jalan terus, karena proses akibat
error diletakkan setelah baris error
Set rng = Target.Resize(1, 1) 'selalu ambil cell pertama yang diproses
With rng 'pada range yang diproses
If LenB(.Value) <> 0 Then 'ada isinya
If .Row > 3 And .Column > 9 And .Column < 12 Then 'dibaris setelah
header pada kolom 10 sampai 11
Set wbkApp = ThisWorkbook
Set shtMain = ActiveSheet
vFile = Array("dataanak.xlsx", "datapa.xlsx") 'simpan nama
workbook
Set wbk = Workbooks(sFile) 'set workbook dengan workbook yang
bernama sesuai sfile
If wbk Is Nothing Then 'workbook belum dibuka
'buka file tanpa update link dan kondisi readonly
Set wbk = Workbooks.Open(ThisWorkbook.Path & "\"
& vFile(.Column
- 10), False, True)
If wbk Is Nothing Then 'gak ada file yang bisa
dibuka
sMsg = "tidak ada workbook bernama " &
vFile(.Column
- 10) & _
" di folder bernama " & ThisWorkbook.Path
GoTo Keluar 'ke blok keluar dibawah sana
End If
End If
wbk.Activate 'aktifkan
workbook
Set sht = wbk.Sheets(.Value) 'set worksheet dalam
workbook sesuai isi range yang diproses
If sht Is Nothing Then 'gak ada sheet dimaksud
sMsg = "tidak ada sheet bernama " & .Value & _
" dalam workbook bernama " & vFile(.Column -
10)
wbk.Close False 'tutup workbook tanpa
di save
GoTo Keluar 'ke blok keluar
dibawah sana
End If
'buat worksheet baru di workbook pemanggil
Set shtNew =
wbkApp.Sheets.Add(after:=wbkApp.Sheets(wbkApp.Sheets.Count))
sht.UsedRange.Copy shtNew.Range("a1") 'copy data tujuan
ke pemanggil di a1
wbk.Close False 'tutup wbk tujuan
'beri nama sheet baru
Err.Clear
lSht = 0
shtNew.Name = .Value
Do While Err.Number <> 0
Err.Clear
lSht = lSht + 1
shtNew.Name = .Value & "_" & lSht
Loop
shtMain.Activate 'aktifkan sheet
pemanggil
sMsg = "Done."
End If
End If
End With
Keluar:
Err.Clear
On Error GoTo 0
Application.ScreenUpdating = True
If Len(sMsg) > 5 Then
MsgBox sMsg, vbCritical
ElseIf Len(sMsg) = 5 Then
MsgBox "Done.", vbInformation
End If
Yang merah untuk menyusun multi file tergantung urutan kolom yang rapat
Wassalam,
Kid.
2013/1/17 Nori Z <[email protected]>
> **
>
>
> Makasih Mr. Kid,
> Sudah bisa..tapi dia cuma mengakses workbook 'DataPA' ..
>
> Jadi agar bisa ngakses workbook 'DataAnak'...,saya tadi tambahkan ajaa
> sFile = "dataanak.xlsx" 'simpan nama workbook
> setelah baris
> sFile = "datapa.xlsx" 'simpan nama workbook
> kira-kira tidak ada masalah kah itu Mr. Kid?
>
> emm,, jika boleh minta bantu lagi dua lagi pertanyaan saya yang belum
> dapat solusinya agar bisa rename sheet dan copy master tabel gimana dnk Mr.
> Kid?...
> Makasih banyak-banyak yaaaa.....
> Moga Tuhan balas kebaikannya....
>
> Best,
> Nori.
>
>
>
> ------------------------------
> *From:* Mr. Kid <[email protected]>
> *To:* [email protected]
> *Sent:* Wednesday, January 16, 2013 11:17 AM
>
> *Subject:* Re: [belajar-excel] Masih tentang bagaimana akses workbook
> yang lain dari sebuah workbook .
>
>
> Oh sorry, ternyata ada yang salah di baris berikut :
> set wbk = workbooks( thisworkbook.path & "\" & sfile
> , false,true )
> harusnya :
> set wbk = workbooks.open( thisworkbook.path & "\" &
> sfile , false,true )
>
> Maaf atas kekhilafan yang terjadi.
> Moga-moga perbaikan diatas bisa menyelesaikan masalah error-nya.
> Mohon kabarnya jika masih muncul error (belum sempet dicoba scriptnya)
>
> Wassalam,
> Kid.
>
> 2013/1/16 Mr. Kid <[email protected]>
>
> Coba copas dulu dari milis ke notepad dan pastikan notepad tidak di-word
> wrap.
> Kemudian copas dari notepad ke dalam prosedur pilihan Anda.
>
> Wassalam,
> Kid.
>
>
>
> 2013/1/16 Nori Z <[email protected]>
>
> **
>
> Dear Mr Kid
> Makasih yaa balasannya,,
> emm tapi itu dimasukkan dimana?
> saya letakkan di Sheet1(Utama) dengan event selection change
> tapi keluar pesan 'Compile Error : Wrong number of arguments or invalid
> property assignment'
> terus dia blok kuning nama prosedurnya dan blok biru kata 'workbooks' di
> baris 17..
>
> saya salah dimana yaa?
> makasih,
>
> Best,
> Nori.
>
> ------------------------------
> *From:* Mr. Kid <[email protected]>
> *To:* [email protected]
> *Sent:* Tuesday, January 15, 2013 8:32 PM
> *Subject:* Re: [belajar-excel] Masih tentang bagaimana akses workbook
> yang lain dari sebuah workbook .
>
>
> Hai Nori,
>
> Letakkan script berikut pada event yang anda sukai antara selection change
> atau before double click
> dim rng as range 'range yang diproses
> dim sFile as string 'nama workbook tujuan
> dim sMsg as string 'wadah pesan ke user
> dim wbk as workbook 'workbook tujuan
> dim sht as worksheet 'nama sheet tujuan
>
> on error resume next 'trap error agar jalan terus, karena proses akibat
> error diletakkan setelah baris error
> set rng=target.resize(1,1) 'selalu ambil cell pertama yang diproses
> with rng 'pada range yang diproses
> if lenb(.value)<>0 then 'ada isinya
> if .row>3 and .column>9 and .column<12 then 'dibaris setelah
> header pada kolom 10 sampai 11
> sfile="datapa.xlsx" 'simpan nama workbook
> set wbk=workbooks(sfile) 'set workbook dengan workbook
> yang bernama sesuai sfile
> if wbk is nothing then 'workbook belum dibuka
> 'buka file tanpa update link dan kondisi readonly
> set wbk = workbooks( thisworkbook.path & "\" & sfile
> , false,true )
> if wbk is nothing then 'gak ada file yang bisa
> dibuka
> smsg="tidak ada workbook bernama " & sfile & _
> " di folder bernama " & thisworkbook.path
> goto keluar 'ke blok keluar dibawah sana
> endif
> endif
>
> wbk.activate 'aktifkan
> workbook
> set sht=wbk.sheets( .value ) 'set worksheet dalam
> workbook sesuai isi range yang diproses
> if sht is nothing then 'gak ada sheet dimaksud
> smsg="tidak ada sheet bernama " & .value & " dalam
> workbook bernama " & sfile
> wbk.close false 'tutup workbook tanpa
> di save
> goto keluar 'ke blok keluar
> dibawah sana
> endif
> sht.activate 'aktifkan worksheet
> endif
> endif
> end with
>
> Keluar:
> err.clear
> on error goto 0
> if lenb(smsg)<>0 then
> msgbox smsg,vbcritical
> endif
>
> Wassalam,
> Kid.
>
> 2013/1/15 Nori Z <[email protected]>
>
> **
>
> Dear all,,
> Please help me.. hikss.. hikss..
> Gimana solusinya ? :(
>
> thanks...
>
> Best,
> Nori.
>
> ------------------------------
> *From:* Nori Z <[email protected]>
> *To:* "[email protected]" <[email protected]>
> *Sent:* Monday, January 14, 2013 11:18 AM
> *Subject:* [belajar-excel] Masih tentang bagaimana akses workbook yang
> lain dari sebuah workbook .
>
>
> Dear All,
> Sebelumnya saya pernah menanyakan topik 'Bagaimana agar bisa akses sel
> dari sheet yang berbeda dan dengan kode yang bersesuaian?'
> Saat itu saya mendapatkan pencerahan dari Master zainul_ulum[at]yahoo[dot]com
> <[email protected]> .
> Saya ucapkan banyak terimakasih ..
>
> Namun saat ini saya ada sedikit kendala, ternyata permasalahannya agak
> sedikit kompleks bagi saya (hmm.. karena saya merasa sangat kesulitan
> menemukan solusinya :( ... )
>
> Pada file terlampir,
> Permasalahannya saya ingin merujuk pada workbook yang lain namun harus
> menuju/merujuk pada sheet yang bersesuaian dengan kode sel yang saya klik
> dari Tabel Utama. Penjelasan permasalahannya sudah saya lampirkan dalam
> file excel ini.
> Yang sangat mumet bagi saya karena form ini merupakan form master / awal
> yang mana nantinya akan dilakukan input data... makanya mesti melakukan
> perintah pencopyan master tabel dari sheet yang satu ke sheet yang lain
> (jika sheet tersebut kosong) pada workbook yang dituju dengan memperhatikan
> kode sel yang diklik sebelumnya... Selanjutnya jika sheet tersebut sudah
> terisi tabel dan data maka perintah yang dilakukan hanya mengakses/merujuk
> pada sheet dimaksud tersebut...
>
> Saya sangat mengharapkan bantuan dari para Master disini...
> Terimakasih,
>
>
> Best,
> Nori.
>
>
>
>
>
>
>
>
>
>
>
