Jumat, 04 Mei 2012

ExcelMacro - gabung data sheet cabang



Berikut adalah contoh macro menggabungkan data pada sheet Cabang ?? ke sheet Gabung. Misal
kita buat file excel dengan nama GabungDataCabang.xls, di dalamnya terdapat 4 sheet yaitu : 

-  Gabung berfungsi sebagai tempat tampungan semua data yang ada di semua sheet Cabang ?? 
-  Cabang berisi data transaksi penjualan, format namanya Cabang<spasi>angka misal : Cabang 1,
   Cabang 2, Cabang 3 dst. Untuk contoh ada 3 sheet Cabang.

Jadi total sheet ada 4, yaitu Gabung, Cabang 1, Cabang 2 dan Cabang 3. Untuk sheet Gabung, atur
tampilannya menjadi sperti berikut :



Kotak dengan tulisan "Gabung Report" adalah shape yang saya modif, yang berfungsi sebagai tombol
untuk menjalankan macro. Sedangkan untuk sheet Cabang atur format tampilan menjadi seperti berikut :


Yang perlu diperhatikan adalah posisi header tabel, dimana pada sheet Cabang ini, header tabel data

berada di baris 1 dan diskripsi header mulai dari kolom A s/d D adalah No, Diskripsi, Jumlah dan tanggal.
Jumlah baris dan isi data di setiap sheet Cabang bisa berbeda-beda, diumpakan sebagai transaksi sales
masing-masing Cabang (jumlah sheet Cabang bisa ditambah / dikurangi dengan format penamaan seperti
di atas). 
Kemudian buka jendela Visual Basic Editor (jika belum tahu silahkan dimari >> memulai-makro-excel ).

Setelah jendela Visual Basic Editor terbuka ketikan code berikut :


  Sub gabung()
  Dim brsAkh, akhBrs As Long
  Range("J4").Value = Format(Now, "hh:mm:ss")
  brsAkh = Range("B" & Rows.Count).End(xlUp).Row + 1
      If brsAkh > 4 Then
      Range("A5:E" & brsAkh).Value = Empty
      End If
      For i = 1 To Sheets.Count
          If Left(LCase(Sheets(i).Name), 6) = "cabang" Then
          akhBrs = Sheets(i).Range("B" & Rows.Count).End(xlUp).Row
              If akhBrs > 1 Then
              Sheets(i).Range("B2:D" & akhBrs).Copy _
              Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1)
              Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1 & ":E" & _
              Range("B" &  Rows.Count).End(xlUp).Row).Value = Sheets(i).Name
              End If
          End If
      Next i
  Range("A5:A" & Range("B" & Rows.Count).End(xlUp).Row).Formula = "=Row()-4"
  Range("J7").Formula = "=SUM(C5:C" & Range("B" & Rows.Count).End(xlUp).Row & ")"
  Range("J5").Value = Format(Now, "hh:mm:ss")
  Range("J6").Value = Format(Range("J5") - Range("J4"), "hh:mm:ss")
  MsgBox "Proses selesai !" & Chr(13) & "Lama " & Format(Range("J6"), "hh:mm:ss"), _
      vbInformation, "Info"
  End Sub


Setelah code macro di atas dicopykan/diketik, pilih sheet Gabung kemudian klik kanan gambar "Gabung
Report" pilih Assign Macro . . .  , maka akan muncul jendela Assign Macro, kemudian klik gabung dan tekan OK.


Selanjutnya macro gabung data cabang sudah bisa di jalankan dengan cara klik gambar "Gabung Report"
(tombol proses macro). Silahkan cek perubahan yang terjadi. :)

Selesai!! sementara ini dulu, untuk penjelasan macro dan contoh file menyusul  ;P

Semoga bermanfaat

Tidak ada komentar:

Posting Komentar