Hot Fox: Re: ]] XL-mania [[ Copy sheet ke Workbook baru dengan nama spt sheet tsb

sexta-feira, 29 de janeiro de 2010

Re: ]] XL-mania [[ Copy sheet ke Workbook baru dengan nama spt sheet tsb

bgmana kalo kita mudahkan begini:

(manual oleh user)

pilih salah satu worksheet dlm workbook tsb dengan cara mengaktifkannnya

(manual oleh user)

Klik-Ganda Cell A1 pada sheet yg sudah dipilih

( ini maksudnya untuk menjalankan makro kita)

(otomatis dikerjakan VBA)

Ya makro nya langsung "jalan" dan "kerja sampai selesai" dong...

Karena dengan diaktifkan sebuah sheet tadi, tanpa perlu tanya-tanya lagi

dia sudah tahu SHEET yg akan di copy ke workbook lain, dan

sudah tahu pula WORKBOOK LAIN itu akan di SaveAs dengan NAMA APA.

'-- module Thisworkbook --

Private Sub Workbook_SheetBeforeDoubleClick( _

        ByVal Sh As Object, _
        ByVal Target As Range, Cancel As Boolean)
   If Target.Cells.Count = 1 Then
      If Target = Cells(1) Then Call SheetToNewBook(Sh)
   End If
   Cancel = True

End Sub

'-- module umum (module: level aplikasi) --

Sub SheetToNewBook(TheSheet As Worksheet)
'---------------------------------------
' membuat salah satu sheet pilihan user
' menjadi workbook baru
' sheet lama tidak didelete
' siti Vi // bluewater, 29 jan 2010
'--------------------------------------

   Dim myPath As String
   myPath = ThisWorkbook.Path & "\"

   TheSheet.Copy
   ActiveWorkbook.SaveAs _

      Filename:=myPath & TheSheet.Name & ".xls"

   ThisWorkbook.Activate
End Sub

Perintah ObjectWorkSheet.Copy

menghasilkan ObjectWorksheet tsb dicopy ke WorkbookBaru

jadi kita tidak perlu meng ADD workbook-baru lebih dulu

Kalau diinginkan sheet di workbook LAMA langsung dihapus

(karena sudah dipindah ke workbook baru);

perintahnya

TheSheet.Move

Ada hal yg perlu diingat yaitu

- apakah di folder (dimana workbook yg memuat makro ini berada)

sudah ada workbook yg namanya SAMA debgab yg akan dibuat oleh makro.

- apakah pada sheet yg ditunjuk ada formula yg me-RUJUK (Link)

ke sheet lain dlm workbook 'awal'

(jika ada) : workbook baru akan punya links ke workbook anda.

mengenai makro yg ditulis pak herry sutjipto

SelectedWorkbook mungkin yg dimaksud = ActiveWorkbook

tetapi ObjecWorkBook.NAME itu adalah property yg READ ONLY

tidak bisa kok tiba-tiba mau diganti dengan nama baru seperti itu

Bisa nya = di SAVE-AS dengan nama baru.

Atau kalau mau di RENAME, workbook-nya kan harus diTUTUP dulu.

SelectedSheets

adalah object collection (kumpulan dari banyak object) yaitu

sheet-sheet yg sedang diselect secara bersamaan (group)

Apakah memang akan ada pen-DELETED-an banyak sheet

dan kapan mereka di select secara bersamaan

text panduan dlm input box

"Masukkan Nama Workbook Baru dengan memilih sheet dalam workbook ini"

Panduan ini mendua arti;

lebih tegas bila kata "MEMILIH" diganti dengan "MENGETIKKAN"

tips:

sebaiknya sebelum menulis makro kita memperhatikan apa saja yg terjadi

jika hal tsb dikerjakan secara manual...

Prosedur (II) di module-umum tsb diatas dapat diringkas menjadi spt ini

Sub SheetToNewBook(CurSht As Worksheet)
   CurSht.Copy
   ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & CurSht.Name & ".xls"
   ThisWorkbook.Activate
End Sub

----- Original Message -----
From: Herry Sutjipto
To: XL-mania@yahoogroups.com
Sent: Thursday, January 28, 2010 9:17 PM
Subject: ]] XL-mania [[ Copy sheet ke Workbook baru dengan nama spt sheet tsb

Dear XL-Mania-er,

Saya punya file excel yang jumlah sheetnya sangat banyak sekali, sehingga file tsb

ukurannya sangat besar. Salah satu sheet dalam file tersebut akan saya kirim ke tempat lain

dengan sarana email, untuk diedit oleh orang lain.
Sheet tersebut akan saya copy ke workbook baru dengan nama seperti nama sheet tersebut,

sehingga file yang saya kirim menjadi kecil ukurannya.
Saya sudah mencoba membuat VBA nya, tetapi kok nggak jalan-2 ….. maklum sudah pikun ……
Mohon bantuan XL-Mania-er untujk memberikan pencerahan kepada saya.
VBA yang sudah saya buat adalah sebagai berikut:

Sub Macro1()
'
Dim wbAwal As String, wbBaru As String
Dim shtAwal As String, shtBaru As String
    wbAwal = ActiveWorkbook.Name
    wbBaru = InputBox(Prompt:="Masukkan Nama Workbook Baru dengan memilih sheet dalam workbook ini", _
               Title:="Membuat WorkBook Baru")
    shtAwal = wbBaru
    wbBaru = wbBaru + ".xls"
    Workbooks.Add
    SelectedWorkbook.Name = wbBaru
    Workbooks(wbAwal).Activate
    Sheets(shtAwal).Select
    Sheets(shtAwal).Copy After:=Workbooks(wbBaru).Sheets(1)
    Sheets("Sheet1").Select
    SelectedSheets.Delete
End Sub

Terima kasih.

Best regards.

__._,_.___

Reply to sender | Reply to group

Messages in this topic (2)

Recent Activity:

New Members 104

Visit Your Group Start a New Topic

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Member ke 13,013 siapa ya? Sini mau dikirimin coklat :D           |
| Member ke 31,031 dapet iPod dehh.... :D :D :D                     |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

MARKETPLACE

Going Green: Your Yahoo! Groups resource for green living