Jika macro sebelumnya pada sel B4 di Sheet Tabel1 kosong maka mengabaikan isi
tabel2 . Maka untuk macro berikut , pengecekan data di tabel2 dilakukan. Sub
Gabung_2()
Dim barisawal, jumlahkolom As Integer
Dim tujuan As Range
Dim asal As Range
barisawal = 4
jumlahkolom = 4
Sheets("Hasil").Activate
Set tujuan = Range("A" & barisawal)
' jika sel A2 kosong , berarti tak ada data
If tujuan.Value <> "" Then
Sheets("Hasil").Activate
tujuan.Select
' menuju akhir baris
Range(Selection, Selection.End(xlDown)).Select
' pilih sampai selebar kolom
Selection.Resize(, jumlahkolom).Select
' hapus isinya
Selection.ClearContents
End If
Sheets("tabel1").Activate
Range("B4").Select
If Selection = "" Then GoTo lab_Tabelkedua
' pilih satu baris data
Range("B4").Resize(1, jumlahkolom).Select
' range berisi data
Range(Selection, Selection.End(xlDown)).Select
Set asal = Selection
asal.Copy tujuan
lab_Tabelkedua:
Sheets("tabel2").Activate
Range("B4").Select
If Selection = "" Then GoTo lab_sort
' pilih satu baris data
Range("B4").Resize(1, jumlahkolom).Select
' menuju data terakhir
Range(Selection, Selection.End(xlDown)).Select
Set asal = Selection
' Belum Ada Data di tujuan , jadi julahbaris = 0
If tujuan.Value = "" Then
jumlahbaris = 0
GoTo Lab_TujuanTakAda
End If
' hitung jumlah baris data
If tujuan.CurrentRegion.Row < barisawal Then
' misal baris awal 2 , maka yg dihitung 2,3,4,5
jumlahbaris = tujuan.CurrentRegion.Rows.Count - barisawal + 1
Else
jumlahbaris = tujuan.CurrentRegion.Rows.Count
End If
Lab_TujuanTakAda:
' ke baris kosong untuk data berikutnya
Set tujuan = Sheets("Hasil").Range("a" & barisawal).Offset(jumlahbaris)
' asal.Copy tujuan.Offset(0)
asal.Copy tujuan
lab_sort:
If tujuan.Value = "" Then
GoTo lab_Selesai
End If
' tujuan dari A2 sampai baris kosong setelah data terakhir ( jumlahbaris )
' ke kolom sesuai jumlah kolom
If tujuan.CurrentRegion.Row < barisawal Then
jumlahbaris = tujuan.CurrentRegion.Rows.Count - barisawal + 1
Else
jumlahbaris = tujuan.CurrentRegion.Rows.Count
End If
Set tujuan = Range("A" & barisawal)
' melingkupi baris sebanyak jumlahbaris
' kolom sebanyak jumlahkolom
Set tujuan = tujuan.Resize(jumlahbaris, jumlahkolom)
' hapus sorting
ActiveWorkbook.Worksheets("hasil").Sort.SortFields.Clear
' tambahkan sorting
ActiveWorkbook.Worksheets("hasil").Sort.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' sort sesuai dengan daerah tujuan
With ActiveWorkbook.Worksheets("hasil").Sort
.SetRange tujuan
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
lab_Selesai:
End Sub'--------------
To: [email protected]
From: [email protected]
Date: Mon, 5 Mar 2012 08:56:54 +0000
Subject: RE: [belajar-excel] menggabungkan 2 tabel
Saya gunakan macro sbb:
Sub Gabung()
Dim barisawal, jumlahkolom As Integer
Dim tujuan As Range
Dim asal As Range
barisawal = 2
jumlahkolom = 4
Set tujuan = Sheets("Hasil").Range("A" & barisawal)
' jika sel A2 kosong , berarti tak ada data
If tujuan.Value <> "" Then
tujuan.Select
' menuju akhir baris
Range(Selection, Selection.End(xlDown)).Select
' pilih sampai selebar kolom
Selection.Resize(, jumlahkolom).Select
' hapus isinya
Selection.ClearContents
End If
Sheets("tabel1").Activate
Range("B4").Select
If Selection = "" Then GoTo lab_selesai
' pilih satu baris data
Range("B4").Resize(1, jumlahkolom).Select
' range berisi data
Range(Selection, Selection.End(xlDown)).Select
Set asal = Selection
' ke sel tujuan
asal.Copy tujuan
' hitung jumlah baris data
If tujuan.CurrentRegion.Row < barisawal Then
' misal baris awal 2 , maka yg dihitung 2,3,4,5
jumlahbaris = tujuan.CurrentRegion.Rows.Count - barisawal + 1
Else
jumlahbaris = tujuan.CurrentRegion.Rows.Count
End If
' ke akhir baris data
Set tujuan = Sheets("Hasil").Range("a" & barisawal).Offset(jumlahbaris - 1)
lab_Tabelkedua:
Sheets("tabel2").Activate
Range("B4").Select
If Selection = "" Then GoTo lab_selesai
' pilih satu baris data
Range("B4").Resize(1, jumlahkolom).Select
' menuju data terakhir
Range(Selection, Selection.End(xlDown)).Select
Set asal = Selection
' copy mulai 1 baris setelah baris data terakhir
asal.Copy tujuan.Offset(1)
lab_selesai:
' tujuan dari A2 sampai baris terakhir ( jumlahbaris )
' ke kolom sesuai jumlah kolom
If tujuan.CurrentRegion.Row < barisawal Then
jumlahbaris = tujuan.CurrentRegion.Rows.Count - barisawal + 1
Else
jumlahbaris = tujuan.CurrentRegion.Rows.Count
End If
Set tujuan = Range("A" & barisawal)
' melingkupi baris sebanyak jumlahbaris
' kolom sebanyak jumlahkolom
Set tujuan = tujuan.Resize(jumlahbaris, jumlahkolom)
' hapus sorting
ActiveWorkbook.Worksheets("hasil").Sort.SortFields.Clear
' tambahkan sorting
ActiveWorkbook.Worksheets("hasil").Sort.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' sort sesuai dengan daerah tujuan
With ActiveWorkbook.Worksheets("hasil").Sort
.SetRange tujuan
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
To: [email protected]
From: [email protected]
Date: Mon, 5 Mar 2012 10:26:36 +0700
Subject: [belajar-excel] menggabungkan 2 tabel
Selamat Siang,
Mohon bantuan dari pakar excel semua, bagaimana formula untuk menggabungkan
dua tabel yaitu tabel 1 dan tabel 2 menjadi table 3 dan tersusun berurutan
berdasarkan tanggalnya. Terimakasih Afdhol
