Gabung beberapa sheets menjadi satu

Dalam melakukan pekerjaan sehari hari di manufacturing, selalu ada peluang untuk melakukan improvement dari sisi administrasi.
Dalam hal ini menggabungkan data dari beberapa sheets excel menjadi satu sheets adalah dalam rangka agar pembuatan laporan untuk jumlah overtime lebih efficient.
Idenya adalah ada beberapa  sheets dalam  satu file, data sheets tersebut adalah data overtime dari berbagai Line produksi,agar mudah untuk mengolah datanya maka kita harus menggabungkan nya terlebih dahulu.
dan cara menggabungkan nya kita gunakakan macro,
kode macro nya seperti dibawah...

Option Explicit

Sub gabung_sheet()
   Application.ScreenUpdating = False
    Dim wrk As Workbook
    Dim sht As Worksheet
    Dim trg As Worksheet
    Dim rng As Range
    Dim colCount As Integer
    Set wrk = ActiveWorkbook
    For Each sht In wrk.Worksheets
        If sht.Name = "Hasil" Then
            MsgBox "Worksheet 'Hasil' sudah ada ." & vbCrLf & _
            "silahkan di delete dulu karena sheet 'Hasil' " & _
            "akan menjadi hasil dari penggabugan ini.", vbOKOnly + vbExclamation, "Error"
            Exit Sub
        End If
    Next sht
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
    trg.Name = "Hasil"
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column
    With trg.Cells(1, 1).Resize(1, colCount)
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value
        .Font.Bold = True
    End With
    For Each sht In wrk.Worksheets
        If sht.Index = wrk.Worksheets.Count Then
            Exit For
        End If
        Set rng = sht.Range(sht.Cells(10, 1), sht.Cells(65536, 22).End(xlUp).Resize(, colCount))
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    Next sht
    trg.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

atau bisa di download contoh file nya  disini.


Post a Comment

11 Comments

  1. Selamat Pagi mas Effendi,

    maaf pagi2 saya sudah bertanya, untuk saat ini saya kan punya data, dimana ada 2 row dengan nama cabang yang sama dan dari masing2 row tersebut ada 2 nama penerima yang berbeda, agar bisa di baca oleh mail merge saya ingin jadikan 2 nama penerima tersebut dalam 1 row dan nama penerima pada row ke2 tadi berpindah ke colom di sebelah penerima pada row 1. dan row 2 akan dihapus.

    saya sudah mencoba dengan beberapa cara pivot maupun dengan formula yang lain, tapi hasilnya tetap tidak bisa, apakah dengan macro hal tersebut bisa teratasi?

    mohon bantuan ilmu dari mas Effendi, dan saya doakan semoga ilmu mas Effendi selalu di tambahkan lebih banyak lagi oleh Tuhan YME, terima kasih atas bantuannya...

    ReplyDelete
  2. sangat bisa di selesaikan dengan macro mas.. kalau ada contoh nya bisa email ke saya, akan saya buatkan macro nya

    ReplyDelete
  3. kok gak bisa ya mas,kepotong, gak semua ke gabung jadi satu..

    ReplyDelete
  4. @thirdta
    Keren mas, all aktif wks langsung merge

    ReplyDelete
  5. gan contohnya tidak bisa di download

    ReplyDelete
    Replies
    1. This comment has been removed by the author.

      Delete
    2. download file nya disini mas
      https://drive.google.com/open?id=17dnDa1ymmdadkVKh33Gth6Z-MWok0QbI

      Delete
  6. jumlah angka yg bisa terbaca hanya 15 digit sedangkan digit yg ke_16 terbaca 0 semua, bagaimana settingnya??

    ReplyDelete
    Replies
    1. download file nya disini mas
      https://drive.google.com/open?id=17dnDa1ymmdadkVKh33Gth6Z-MWok0QbI

      Delete
  7. Mas saya baru belajar macro, tiba 2x ada permintaan menggabungkan sheet, bagaimANA AKu coba ga bias bias

    ReplyDelete