Saat sebelum Kamu melaksanakan Import Informasi dari Excel ke Excel bacalah petunjuk dibawah ini yang bisa jadi ini bisa menolong Kamu lebih gesit dalam menguasai maksud yang kami sampaikan ini.
Panduan melakukan import data dari file excel ke excel.
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
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
Jika kalian melakukan langkah-langkah diatas secara benar serta penempatan Kode Macro yang sesuai maka sistem Microsoft Excel akan bekerja sesuai dengan apa yang telah dimaksudkan. Jika Anda mendapatkan masalah dalam melakukan langkah-langkah diatas silahkan hubungi atau tuliskan di dalam komentar.
