ketika nama Sheet menjadi bebas, maka kita
masih dapat merujuk melalui index-nya
oleh sebab itu URUTAN susunan dan cacah Tab Sheet
pada workbook 'TUJUAN'
harus SAMA dengan URUTAN dan cacah Column-Heading
(nama plant?) pada workbook 'SUMBER'
Sub Begini(Sumber As String, Tujuan As String)
'-------------------------------------------
' siti Vi mentranspose antar sheets/book
' rev_2: 30 mar 2010 / milis [belajar excel]
'-------------------------------------------
Dim sht As Worksheet, Plants As Range
Dim nPlant As Integer, bl As Integer
Workbooks(Tujuan).Activate
Set Plants = Workbooks(Sumber).Sheets(1).Cells(3).CurrentRegion
Set Plants = Plants.Offset(0, 2).Resize(1,
Plants.Columns.Count - 3)
For Each sht In Workbooks(Sumber).Worksheets
bl = bl + 1
For nPlant = 1 To Plants.Columns.Count
sht.Range("B2:B5").Offset(0, nPlant).Copy
Workbooks(Tujuan).Sheets(nPlant).Range("B2:B5").
_
Offset(0, bl).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Next nPlant
Next sht
End Sub
'----------------ctv
note:-------------------------------------------
' cara lain tentu masih ada (dan banyak)
' makro ini mengandalkan urutan nama Plant kolom Heading:
A,B,C,D dst)
' pada workbook SUMBER di tiap sheet pada range C1: ke kanan
' harus sama dengan [urutan nama tab-sheet] pada
workbook TUJUAN
'---------------------------------------------------------------------
----- Original Message -----
Sent: Tuesday, March 30, 2010 1:25 PM
Subject: Re: [belajar-excel] Re: Transpose Rekap Laporan
Dear all,
Maaf baru memberi tanggapan.
Solusi yang diusulkan oleh mbak Siti sama seperti yang saya inginkan.
Kondisi sebenarnya, template untuk file "Mau Jadi Ini" memang sudah ada.
Saya masih awam dengan makro, tapi kalo saya lihat nama plant GTG-1
sampai GTG-8 menjadi referensi (Offset) untuk melakukan copy paste.
Workbooks(tujuan) .Sheets(" GTG-" & gtg). _
Range("B2:B5" ).Offset( 0, bl).PasteSpecial xlValue
Sekarang bagaimana kalau nama plant tidak beraturan (contoh plant
A,B,C,D dan seterusnya), apakah tinggal diganti menjadi
Workbooks(tujuan) .Sheets& gtg _
Range("B2:B5" ).Offset( 0, bl).PasteSpecial xlValue
Sekali lagi saya ucapkan banyak terima kasih.
Regards,
Andri
NB: Untuk moderator maaf atas nickname-nya, itu memang kealpaan dari
saya. Saya sudah ganti, insyaallah berubah.
__________ Information from ESET NOD32 Antivirus, version of virus
signature database 4983 (20100329) __________
The message was checked by ESET NOD32 Antivirus.
http://www.eset.com
