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" & _
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"), _
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
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