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 TELP, ID
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 ADA LEBIH DARI 20 EMPTY ROW

'

'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

                    Loop 'ROW OK

                    intROWGABUNG = intROWGABUNG + 1

                'EMPTY ROW

                Else

                    intROWSTOP = intROWSTOP + 1

                End If 'EMPTY ROW

               

                'NEXT DATA

                intROWDATA = intROWDATA + 1

            Loop 'READ DATA

        End With 'READ DATA

       

        'NEXT SHEET

        intSHEETNO = intSHEETNO + 1

       

    Loop 'READ DATA

 

'END OF MENGGABUNGKAN DATA SHEETS(2), SHEETS(3) DST. KE DALAM SHEETS(1)

End Sub

 

 

 

EXIT

 

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.