Oke Pak Hendrik.
Ditambahkan pembuat nama sheet.
Prosedur event change si worksheet jadi :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shtTpl As Worksheet, shtNew As Worksheet
Dim pvt As PivotTable
Dim lRows As Long
Dim sShtName As String
Set shtTpl = Sheet6
If Not Intersect(Target, shtTpl.Range("e6")) Is Nothing Then
sShtName = shtTpl.Range("e6").Value
On Error Resume Next
Application.DisplayAlerts = False
Sheets(sShtName).Delete
Application.DisplayAlerts = True
Set shtNew = Sheets.Add(after:=Sheets(Sheets.Count))
shtNew.Name = sShtName
Set pvt = shtTpl.PivotTables(1)
Err.Clear
On Error GoTo 0
With shtNew
'copy info output
shtTpl.Range("d3:e6").Copy
.Range("a1").PasteSpecial xlPasteValues
'copy data output
pvt.TableRange1.Copy
.Range("b6").PasteSpecial xlPasteValues
'susun nomor urut
lRows = pvt.RowRange.Rows.Count
.Range("a8").Resize(lRows, 1).Formula = "=row()-8"
.Calculate
.Range("a8").Resize(lRows, 1).Value =
.Range("a8").Resize(lRows, 1).Value
.Range("a8").Value = "NO"
'finishing
.Range("a6:a7").EntireRow.Delete 'hapus
baris column fields pivot
.Range("a6:b6").EntireColumn.AutoFit
'autofit hasil
.Range("a6").CurrentRegion.Offset(0, 2).NumberFormat =
"#,###" 'set number format
.Range("a6").CurrentRegion.Offset(0, 2).ColumnWidth = 12
End With
End If
End Sub
Yang hijau adalah tambahannya. Sheet yang sudah ada akan dihapus lebih dulu,
untuk menjaga :
1. ukuran file tetap tergantung jumlah record data dan jumlah cabangnya.
2. data yang ditampilkan adalah data terakhir diproses.
Jika akan membuat nomor indeks sheet untuk nama cabang yang sama, keluarkan
bagian mulai :
On Error Resume Next
sampai :
On Error GoTo 0
kesebuah prosedur baru yang khusus mengurusi pembuatan indeks sheet pada cabang
yang sama.
Kemudian ganti bagian yang kosong tersebut dengan perintah memanggil
prosedur baru itu.
Dengan begitu, maka prosedur baru bisa dibuat menjadi sebuah prosedur
public yang bisa dicomot dan dipakai di workbook lain dengan mudah. Jika
disatukan dalam prosedur event change, maka penggunaan pada workbook lain
akan membutuhkan penyusunan ulang untuk disesuaikan dengan kondisi workbook
setempat.
Wassalam,
Kid.
2012/11/3 hendrik karnadi <hendrikkarn...@yahoo.com>
> **
>
>
> Sungguh jawaban yang luar biasa.
>
> Supaya pas dengan keinginan yang empunya soal "secara otomatis
> memperbanyak sheet/file sesuai dengan nama cabang yang ada di validation
> list"
> kalau boleh usul, disisipkan satu code pada vba sheet6(myTpl) pada bagian
> ini:
> Set shtNew = Sheets.Add(after:=Sheets(Sheets.Count))
> shtNew.Name = Range("e6").Value
> Set pvt = shtTpl.PivotTables(1)
>
> Salam,
> Hendrik Karnadi
>
>
> ----- Forwarded Message -----
> *From:* Mr. Kid <mr.nm...@gmail.com>
> *To:* belajar-excel@yahoogroups.com
> *Sent:* Saturday, 3 November 2012, 6:23
> *Subject:* Re: [belajar-excel] perbanyak sheet berdarkan validation list
>
>
> Hai Johan,
>
> Untuk penyusunan formula output seperti sheet out_tpl_formula, tapi belum
> ada VBA untuk meng-create setiap sheet untuk cabang terpilih. Biasanya
> banyak BeExceller yang suka membuat formulanya dan variasi formulanya
> juga cukup banyak. Untuk meng-create sheet cabang terpilih dengan VBA
> memanfaatkan template yang menggunakan formula, kita tunggu saja.
> Sekarang sudah cukup banyak BeExceller yang suka bermain dengan VBA.
>
> File terlampir memanfaatkan pivot table saja, termasuk dalam meng-create
> sheet cabang terpilih. Agak jarang ditemui BeExceller yang mau bermain
> VBA terhadap pivot table. Semoga file terlampir bisa membantu
> memasyarakatkan pivot table beserta otomasinya dengan VBA (supaya variasi
> ide dalam milis semakin bertambah karena semakin banyak yang mau
> mempelajarinya).
>
>
> Wassalam,
> Kid.
>
>
>
> 2012/11/2 Johan hung <johan.h...@gmail.com>
>
> **
>
> Dear Master Excel,
>
> Mohon bantuan rekan-rekan, adakah cara untuk untuk memperbanyak worksheet /
> workbook berdasarkan validation list secara otomatis.
>
> Data contoh terlampir
>
> thanks
>
> Johan
>
> --- Mods ---
> Mohon tidak menyertakan cc atau bcc
> ------------
> _
>
>
>
>
>
>
