bgmana kalo kita mudahkan begini: 1. (manual oleh user) pilih salah
satu worksheet dlm workbook tsb dengan cara mengaktifkannnya 2.
(manual oleh user) Klik-Ganda Cell A1 pada sheet yg sudah dipilih (
ini maksudnya untuk menjalankan makro kita) 3. (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
--- In belajar-excel@yahoogroups.com, Herry Sutjipto <herry...@...>
wrote:
>
> Dear All,
>
> 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()
> '
> ' Macro1 Macro
> '
> 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.
