kirimpertanyaan

 

Belajar dan konsultasi masalah Excel      

Salam Excel untuk semua..

Berikut adalah project sample VBA Macro untuk menggabungkan data dari beberapa file XLSX ke dalam sebuah file. Tidak hanya menggabungkan, tapi mengubah susunan data yang sebelumnya dari atas ke bawah (kolom) menjadi ke samping (baris).

Saya tidak akan banyak memberikan penjelasan di sini sehingga akan lebih baik jika disempatkan membaca project sample saya lainnya berikut:

http://klinikexcel.com/articles/project-samples/item/43-lain-lain/180-cloning-beberapa-file-sekaligus-dengan-mengubah-formula-jadi-value

Beberapa hal basic (terutama awalannya) memiliki penjelasan yang sama. Perbedaannya hanya pada baris program  atau code. Berikut adalah codenya:

Sub gabungkan()

Dim JumlahFile As Integer
Dim NamaFileUtama, NamaFileBaru, NamaFileTerbuka, PathFileTerbuka
Dim LastRow As Long
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim sh As Worksheet

'code untuk memilih file.
'code ini akan memunculkan window dialog untuk memilih file.
'file yang dipilih akan disimpan di variabel "FileTerpilih".
FileTerpilih = Application.GetOpenFilename("Excel File (*.xlsx),*.xlsx,XLS Files (*.xls),*.xls", _
Title:="Pilih file..", MultiSelect:=True)

'jika pengguna membatalkan pemilihan file, maka keluar dari Sub prosedur.
If VarType(FileTerpilih) = vbBoolean Then
Exit Sub
End If

'cari jumlah file yang dipilih oleh pengguna.
JumlahFile = UBound(FileTerpilih)

'cari path file terpilih untuk menyimpan nanti
PathFileTerpilih = Left(FileTerpilih(1), InStrRev(FileTerpilih(1), Application.PathSeparator, , 1))

'simpan dulu nama file utama atau file yang memiliki macro untuk proses pemanggilan nanti.
NamaFileUtama = ActiveWorkbook.Name

'Buat workbook baru untuk menampung gabungan file dan simpan di path yang sama
Set WB2 = Workbooks.Add
With WB2
.Title = "Gabungan"
.Subject = "Gabungan"
.SaveAs Filename:=PathFileTerpilih & "Gabungan.xlsx"
End With

'akan mulai penggabungan
'matikan diplay alert agar tidak muncul window yang membutuhkan interaksi user.
Application.DisplayAlerts = False

'mulai buka file satu per satu dengan looping.
For i = 1 To JumlahFile

'Buka file yang dipilih.
Workbooks.Open FileTerpilih(i)

Set WB1 = ActiveWorkbook
NamaFile = WB1.Name

'Cari baris terakhir file terpilih
BarisTerakhir = WB1.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row

'Copy isi kolom A sampe baris terakhir
WB1.Worksheets(1).Range("A1:A" & BarisTerakhir).Copy

'Ambil posisi terakhir pada file tampungan gabungan
BarisTerakhir2 = Workbooks("Gabungan.xlsx").Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
KolomTerakhir = Workbooks("Gabungan.xlsx").Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

'paste dengan transpose pada file gabungan
Workbooks("Gabungan.xlsx").Worksheets(1).Cells(BarisTerakhir2, KolomTerakhir).PasteSpecial Transpose:=True

'tutup file terpilih
Workbooks(NamaFile).Close

'aktifkan diplay alert agar tidak muncul window yang membutuhkan interaksi user.
Application.DisplayAlerts = True
Next i
MsgBox "Proses Penggabungan File Selesai!"

End Sub

Download Silahkan login untuk download


0
By: wahyuputraf On: Wednesday, 16 November 2016

a

Kitab VBA Excel Level Satu

Buat pemula yang serius pengen belajar MACRO VBA Excel, silahkan baca buku berikut:

Kitab VBA Excel Level Satu edisi 2 sEDISI 2 : Rp. 60.000

BELI VERSI CETAK KLIK DI SINI

BELI VERSI DIGITAL KLIK DI SINI

LIHAT PREVIEW KLIK DI SINI

 523952 342835842418972 309765083 n

EDISI 1 : DISKON 50% - Rp. 30.000

UNTUK PEMBELIAN KONTAK :

Call/SMS/ whatsapplogo : 0812 1283 1148

Partners

logo baru local1news

Newsletter

Daftarkan email anda untuk mendapatkan update dari Klinik Excel