Selamat Pagi Dioni,
Andai ada sekelumit contoh datanya, maka akan lebih mudah bagi BeExceler
untuk membantu menyusun solusi.
Contoh yang anda gunakan, memiliki tabel dengan header 1 baris di baris 1
mulai cell A1 dan tidak ada kolom kosong tanpa header. Data (record pertama)
mulai dari baris 2 dan tidak pernah ada baris kosong antar record. Oleh
sebab itu penggunaan currentregion menjadi lebih efektif.
Tabel yang akan anda olah mulai dari A7. Mari diasumsikan pada tabel yang
akan disalin,
1. baris *A7 adalah header dan hanya berisi 1 baris* tanpa ada kolom kosong
tak ber-header.
2. *record pertama mulai dari A8* dan tidak ada baris kosong antar record.
3. data yang disalin adalah seluruh data dengan struktur yang sama pada
seluruh sheet yang namanya diawali dengan kata comb
Hal ini berarti, tabel data berupa sebuah area bersambung yang dibatasi
baris kosong setelah record terakhir dan kolom kosong setelah header
terkanan.
Nama sheet destinasi sebaiknya tidak diawali dengan comb agar lebih simple.
Jika tabel destinasi adalah combine, maka 4 karakter pertamanya sama dengan
kriteria nama sheet yang datanya akan disalin. Mari diasumsikan nama sheet
destinasi adalah TCombine
Tabel destinasi ada disheet TCombine, header 1 baris di baris 1 mulai A1.
Data mulai di A2.
'------- kode mulai disini -----------
'deklarasi variabel
dim lRowDB as long, lRecNew as long, lRows as long
dim rngDestinasi as range, rngNewData as range
dim sht as worksheet
dim sMsg as string
'init range patokan destinasi
set rngdestinasi=sheets("TCombine").range("a1")
lrowdb=rngdestinasi.rows.count
set rngdestinasi=rngdestinasi.offset( lrowdb )
'init variabel pesan
smsg = "Penggabungan Selesai." & vbCrLf & vbCrLf & "SheetName: |
RowsCount:" & vbCrLf
lrecnew=0
'loop tiap sheet
for each sht in thisworkbook.worksheets
if instr( lcase$(sht.name) , "comb" ) = 1 then
set rngnewdata=sht.range("a7").currentregion.offset(1)
lrows=rngnewdata.rows.count-1
if lrows>0 then 'siapa tahu ada sheet yang isinya hanya
header tanpa ada record data
'copas
rngnewdata.resize(lrows).copy rngdestinasi.offset(lrecnew)
'set nilai keterangan
smsg=smsg & sht.name & vbTab & vbTab & lrows & vbCrLf
lrecnew=lrecnew+lrows
endif
endif
next sht
'susun pesan
if lrecnew>0 then
smsg=smsg & vbcrlf & "Total record baru : " & lrecnew & vbcrlf & _
"Jumlah record database berubah dari " & lrowdb-1 & " menjadi
" & lrowdb-1+lrecnew & " record(s)"
msgbox smsg, vbinformation, "LAPORAN......."
else
msgbox "Tidak ada data yang disalin." & vbcrlf & _
"Jumlah record database tetap sejumlah " & lrowdb-1 & "
record(s)", vbexclamation , "LAPORAN......."
endif
'--------- kode selesai disini ------------
>> Arti dari Set MoveTbl = *MoveTbl*.Resize(*MoveTbl*.Rows.Count - 1 apa ya?
** set variabel object range bernama MoveTbl dengan suatu range dalam *
movetbl* yang diubah luasan areanya pada sisi baris menjadi sebanyak jumlah
baris range *movetbl* dikurangi 1.
>> tabel yang akan saya copy mulai dari A7, jadi Set MoveTbl =
W.Cells(6).CurrentRegion.Offset(6, 0)
Dengan code diatas yang tercopy cuma 1 baris A7
** Sepertinya letak kebingunannya pada pemahaman object Cells.
cell pertama selalu pada baris ke 1 dan kolom ke 1
Pada object cells yang menjadi properti dari woorksheet, patokannya adalah
A1
Pada object cells yang menjadi properti dari suatu range, patokannya adalah
range terpojok kiri atas dari object range tertentu tersebut.
Contoh pada penggunaan* cells sebagai properti worksheet* :
Syntax : Cells( [rowindex] , columnindex ) --> tanda kurung siku artinya
optional dan ada nilai defaultnya
Cells( 3 , 4 ) artinya cell di baris ke-3 dan kolom ke-4, yaitu D3
Cells( 1 , 5 ) artinya cell di baris ke-1 dan kolom ke-5, yaitu E1
Cells( , 5 ) sama dengan cells( 1 , 5 ) karena nilai default rowindex adalah
1
Cells( 2 , 1 ) artinya cell di baris ke-2 kolom ke 1, yaitu A2
syntax : Cells( [items] )
Cells( 1 ) artinya cell pertama, di Excel, cell pertama adalah A1
Cells( 6 ) artinya cell keenam, di Excel, cell keenam adalah F1 (bergerak
arah horisontal sepanjang kolom, kemudian pindah baris)
Cells( ) artinya semua cells yang ada di worksheet
Jadi, pada W.Cells(6).CurrentRegion.Offset(6, 0) berarti :
"pada worksheet W cells ke 6 (yaitu F1) tentukan area bersinggungannya
(currentregion) kemudian lompat 6 baris dan 0 kolom (Offset)"
Salam.
Kid.
On Sun, Sep 11, 2011 at 05:31, Dioni <[email protected]> wrote:
> **
>
>
> Pagi semua.
> Saya mendapatkan kesulitan untuk menggabungkan sheet. Mohon bantuannya ya.
>
> If Left(W.Name, 4) <> "comb" Then
> Set MoveTbl = W.Cells(6).CurrentRegion.Offset(6, 0)
> Set MoveTbl = MoveTbl.Resize(MoveTbl.Rows.Count - 1, MoveTbl.Columns.Count)
> tRows = MoveTbl.Rows.Count
> Urutan = Urutan & W.Name & vbTab & vbTab & tRows & vbCrLf
> MoveTbl.Copy Destination:=DestRange
> Set DestRange = DestRange.Offset(tRows, 0)
>
> Arti dari Set MoveTbl = MoveTbl.Resize(MoveTbl.Rows.Count - 1
> apa ya?tabel yang akan saya copy mulai dari A7, jadi Set MoveTbl =
> W.Cells(6).CurrentRegion.Offset(6, 0)
> Dengan code diatas yang tercopy cuma 1 baris A7 aja dari 12 sheet
>
> Melihat contoh :
> Sub GabungTabelSheet()
>
> Dim W As Worksheet, Urutan As String
> Dim MoveTbl As Range, DestRange As Range
> Dim N As Long, tRows As Long
> Const msg As String = "Penggabungan Selesai." & vbCrLf & vbCrLf & _
> "SheetName: | RowsCount:" & vbCrLf
> Set DestRange = Sheets("combine").Range("A2")
> N = 0
> For Each W In Worksheets
> If Left(W.Name, 4) <> "comb" Then
> Set MoveTbl = W.Cells(1).CurrentRegion.Offset(1, 0)
> Set MoveTbl = MoveTbl.Resize(MoveTbl.Rows.Count - 1, MoveTbl.Columns.Count)
> tRows = MoveTbl.Rows.Count
> Urutan = Urutan & W.Name & vbTab & vbTab & tRows & vbCrLf
> MoveTbl.Copy Destination:=DestRange
> Set DestRange = DestRange.Offset(tRows, 0)
> N = N + CLng(tRows)
> End If
> Next W
> Application.CutCopyMode = False
> MsgBox msg & Urutan & "Total Rows digabung: " & N, vbInformation,
> "LAPORAN...:"
> End Sub
>
> contoh ini pas di run macronya smua tercopy dan jika saya tambah 1 baris
> dan saya run ulang baris itu jg ikut tercopy.
>
> Mohon bantuannya ya?
>
> Terima Kasih
>
> Dioni
>
>
>
