Combining Several Sheets.
2008/10/13 nono Iskandar <nonoiskandar@gmail.com>
Selamat pagi Pak Safri.
Saya anggota milis xl-mania. Saya sudah baca
pesan bapak dan download
lampiran yg disertakan. Kebetulan saya sebagai bendahara gaji guru di
kecamatan Manding, Kab. Sumenep Madura. Saya merasa sangat
terbantu
dengan lampiran file excel dari Bapak.
Melalui email ini saya mau nanya;
apakah bisa nama kolom hanya
muncul
di atas tabel
saja (tabel hasil penggabungan) , tidak usah
dimunculkan
lagi di tengan
tabel. Jadi, judul kolom NAMA, ALAMAT, NOMOR
NUMBER pada tabel gabungan (sheet 1) hanya muncul di atas
tabel saja.
Tidak usah muncul lagi
di tengan tabel.
Saya punya 22 tabel tiap bulan berkaitan
dengan gaji dan potongan guru.
Terima kasih atas bantuan
Bapak.
Nono Iskandar
Sumenep
2008/10/13 Safri Ishak <safri.ishak@gmail.com>
Selamat pagi
Pak Nono Iskandar,
Alhamdulillah makro yang saya
kirim dapat membantu pekerjaan Bapak.
Untuk lebih memudahkan penempatan header hanya satu kali, maka saya menganjurkan agar Bapak menetapkan standarisasi, dalam hal ini misalnya
data harus dimulai di row ke tujuh.
Header yang diperlukan dapat
Bapak tulis di sheets "Gabungan" dan data di sheet ini juga dimulai
dari row ke tujuh.
Silahkan download dan coba attachment file berikut ini, mudah2an sesuai dengan permintaan Bapak and Good Luck.
Seandainya ada pertanyaan jangan segan2 mengirim email kepada saya.
Insya Allah case study ini akan saya masukkan
ke TB512 Excel VBA for Beginners www.tb512.com/excelvba
--
Thank you and regards,
Safri
www.tb512.com my virtual
home
www.tebetbarat.com Tebet Business Directory consists of addresses and phone
numbers of favorite restaurants, traditional markets, hotels, offices, schools,
super markets, malls, automotive, gardens, flowers, cakes, advertising,
computers, salons, barber shops, cosmetics, banks, apartments etc.
Originally it was compiled for personal purposes and then published to the
internet as a gateway to search business directory and websites in Tebet and surrounding area.
Bedah Makro:
cmdGABUNG merupakan
procedure utama dalam makro ini yaitu
untuk menghitung ulang seandainya terjadi perubahan dari Cost Code Group yang dipilih
melalui tombol Spinner 1 atau ada data yang berubah atau ditambah.
Sub cmdGABUNG()
'MENGGABUNGKAN DATA SHEETS(2), SHEETS(3)
DST. KE DALAM SHEETS(1)
'DATA DIANGGAP SELESAI KALAU
'
'DATA GABUNGAN DIMULAI DARI ROW 7 (intROWSTART)
'DATA DISETIAP DATA SHEETS JUGA MULAI DI ROW YANG SAMA
'ARTINYA HEADER MULAI DI ROW 6 (intROWSTART
- 1)
'
Dim intSHEETNO As Integer
Dim intROWGABUNG As Long
Dim intROWDATA As Long
Dim intCOLDATA As Integer
Dim intROWSTOP As Integer
Dim intCOLSTOP As Integer
Dim blnOK As Boolean
Const intROWSTART As
Integer = 7 'GANTI ROW NO. SESUAI KEBUTUHAN
'CLEAR DATA
GABUNGAN
intROWGABUNG
= intROWSTART
Range("A"
& intROWGABUNG).Select
If Selection.Value
<> Empty Then
Range(Selection,
ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("A"
& intROWGABUNG).Select
End If 'CLEAR DATA
GABUNGAN
'READ DATA
intSHEETNO = 2
Do
'SELECT SHEET DATA
Err.Clear
On Error Resume Next 'ERROR HANDLING
Sheets(intSHEETNO).Select
'SHEET DATA NOT
FOUND
If Err.Number <> 0 Then
Exit Do
End If 'SHEET DATA
NOT FOUND
On Error GoTo 0 'RESET ERROR HANDLING
'RETURN TO SHEETS(1) GABUNG
Sheets(1).Select
'SHEET DATA
With Sheets(intSHEETNO)
'READ DATA
intROWDATA = intROWSTART
intROWSTOP = 0
Do While intROWSTOP < 21
'CHECK EMPTY
ROW
blnOK = False
For intCOLSTOP = 1 To 20
'DATA NOT
EMPTY
If .Cells(intROWDATA, intCOLSTOP) <> Empty Then
blnOK = True
Exit
For
End If
'DATA NOT EMPTY
Next intCOLSTOP 'CHECK EMPTY ROW
'ROW OK
If blnOK = True Then
intROWSTOP = 0
intCOLSTOP = 0
intCOLDATA = 1
Do While intCOLSTOP < 21
'CELLS OK
If .Cells(intROWDATA, intCOLDATA) <>
Empty Then
intCOLSTOP = 0
Cells(intROWGABUNG, intCOLDATA) = .Cells(intROWDATA, intCOLDATA)
End
If 'CELLS OK
'NEXT
intCOLSTOP = intCOLSTOP
+ 1
intCOLDATA = intCOLDATA
+ 1
intROWGABUNG = intROWGABUNG
+ 1
'EMPTY ROW
Else
intROWSTOP
= intROWSTOP + 1
End If 'EMPTY
ROW
'NEXT DATA
intROWDATA = intROWDATA
+ 1
End With 'READ DATA
'NEXT SHEET
intSHEETNO = intSHEETNO + 1
'END OF MENGGABUNGKAN DATA SHEETS(2),
SHEETS(3) DST. KE DALAM SHEETS(1)
End Sub
Tebet Business Directory Alamat Usaha Kita
Free Posting IKLAN GRATIS, send your name, address,
telephone, email id, website and brief description of your business to AdminTebetbarat.com
More information about
www.TB512.com Click HERE.