VBA MACRO EXCEL IMPORT FILE EXCEL KE EXCEL

KODE MACRO IMPOR FILE EXCEL KE EXCEL
Anda juga dapat melihat Koleksi Aplikasi Excel Gratis yang sudah kami sediakan.

Sebelum Anda melakukan Import Data dari Excel ke Excel bacalah petunjuk dibawah ini yang mungkin ini akan membantu Anda lebih cepat memahami maksud kami.

Petunjuk

• Seperti yang telah kami sampaikan diatas, sebelum Anda melakukan Import Data dari excel ke excel, pertama adalah silahkan Anda membuat satu file excel yang berextensi macro biasanya berextensi .xlsx (untuk nama file terserah Anda).
• Setelah membuat file, sekarang silahkan membuat Tombol Active X Control melalui menu ribbon developer excel. Untuk membuat tombol yang dimaksud, Anda dapat membaca artikel sebelumnya "Cara Membuat Tombol Active X Control Melalui Menu Ribbon Developer".
• Double klik tombol maka akan masuk ke jendela Visual Basic for Application (VBA) dan masukan Kode Macro dibawah ini.

Dim vWrkBookSumberData As Variant
vWrkBookSumberData = "File Excel (*.xls*),*.xls*"
vWrkBookSumberData = Application.GetOpenFilename(vWrkBookSumberData, 1, "Pilih File Sumber:", , True)
If Not IsArray(vWrkBookSumberData) Then Exit Sub
SalinData ThisWorkbook.Sheets("Sheet1"), vWrkBookSumberData
MsgBox "succes full", vbInformation

• Langkah selanjutnya silahkan membuat module dan masukan kode Macro dibawah ini.

Function SalinData_dari_WsTerpilih(wShtTujuan As Worksheet, wShtSumber As Worksheet) As Boolean
Dim lRangeTujuanSalinanData As Long, lBarisAkhir As Long, lKolomAkhir As Long
SalinData_dari_WsTerpilih = False
'Jika Worksheet tujuan dan sumber tidak ada
If wShtTujuan Is Nothing Then Exit Function
If wShtSumber Is Nothing Then Exit Function
With wShtTujuan
'Tiga baris kosong di atas data yang disalin
lRangeTujuanSalinanData = .Range("A" & .Rows.Count).End(xlUp).Row + 3
End With
'Menyalin data dari Worksheet sumber
With wShtSumber
If .FilterMode Then .ShowAllData
lBarisAkhir = .Range("A" & .Rows.Count).End(xlUp).Row
lKolomAkhir = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), .Cells(lBarisAkhir, lKolomAkhir)).Copy
wShtTujuan.Range("A" & lRangeTujuanSalinanData).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
SalinData_dari_WsTerpilih = True
End Function
Function SalinData_dari_WbTerpilih(wShtTujuan As Worksheet, sDirektoriSumber As String, bFilePertama As Boolean) As Boolean
Dim lGaring As Long, wWrkBookSumber As Workbook, sNamaWbSumber As String, bTerbuka As Boolean
SalinData_dari_WbTerpilih = False
If wShtTujuan Is Nothing Then Exit Function
'Ketika file sumber data yang dipilih hanya satu, sheet Ledger dikosongkan
If bFilePertama Then
With wShtTujuan
If .FilterMode Then .ShowAllData
.Cells.Clear
End With
End If
'Jika direktori sumber jumlah karakternya lebih kecil dari 5
If Len(sDirektoriSumber) < 5 Then Exit Function
'Menentukan posisi garing
lGaring = InStrRev(sDirektoriSumber, Application.PathSeparator)
If lGaring = 0 Then Exit Function
'Mengambil nama Workbook
sNamaWbSumber = Mid(sDirektoriSumber, lGaring + 1)
bTerbuka = True
On Error Resume Next
'Pengaturan Workbook sumber
Set wWrkBookSumber = Workbooks(sNamaWbSumber)
'Jika Workbook sumber tidak ada
If wWrkBookSumber Is Nothing Then
bTerbuka = False
Set wWrkBookSumber = Workbooks.Open(sDirektoriSumber, False, True)
End If
On Error GoTo 0
'Jika Workbook sumber ada
If Not wWrkBookSumber Is Nothing Then
lGaring = 0
With wWrkBookSumber
'Ketika judul data dari file sumber ingin disalin, bJudul bernilai True
If SalinData_dari_WsTerpilih(wShtTujuan, Worksheets(1)) Then
lGaring = lGaring + 1
End If
'True bernilai 1 dan False bernilai 0
SalinData_dari_WbTerpilih = lGaring > 0
If Not bTerbuka Then
.Close False
End If
End With
Set wWrkBookSumber = Nothing
End If
Application.StatusBar = False
End Function
Sub SalinData(wShtTujuan As Worksheet, vWrkBookSumberData As Variant)
Dim lBanyaknyaFile As Long
'Pengaturan layar agar tidak berkedip dan icon kursor
With Application
.ScreenUpdating = False
.Cursor = xlWait
End With
If IsArray(vWrkBookSumberData) Then
'Jika file Excel yang dipilih lebih dari satu
For lBanyaknyaFile = LBound(vWrkBookSumberData) To UBound(vWrkBookSumberData)
Call SalinData_dari_WbTerpilih(wShtTujuan, CStr(vWrkBookSumberData(lBanyaknyaFile)), lBanyaknyaFile = LBound(vWrkBookSumberData))
Next lBanyaknyaFile
Else
'Jika file Excel yang dipilih satu, bFilePertama bernilai True (benar)
Call SalinData_dari_WbTerpilih(wShtTujuan, CStr(vWrkBookSumberData), True)
End If
'Pengaturan sheet tujuan (sheet Ledger)
With wShtTujuan
.Parent.Activate
.Activate
.Range("A1").Select
End With
'Pengaturan default
With Application
.StatusBar = False
.Cursor = xlDefault
.ScreenUpdating = True
End With
End Sub

• Untuk mencoba Kode Macro diatas, silahkan tekan f5.
• Setelah berhasil, langkah telakhir adalah silahkan simpan.

Jika Anda melakukan langkah-langkah diatas dengan benar serta penempatan Kode Macro yang sesuai maka sistem Microsoft Excel akan bekerja sesuai yang dimaksud. Jika Anda mendapatkan masalah dalam melakukan langkah-langkah diatas silahkan hubungi kami.

"Kami selalu berusaha memberikan yang terbaik dan original"

Jabat Erat@Hak Cipta 2015

Share :