Catetan

COPY MULTIFILE EXCEL DI SATU FOLDER 12


Posting ini aku buat, karena banyaknya request mengenai copy multi file excel.
Sebelumnya aku pernah membuat postingan mengenai copy data multifile excel yang bersifat dasar.

Sekalian mo kasih informasi kalau tulisan di blog ini, aku buat bukan karena sok tahu atau sok ngajarin, tetapi sebagai catatan dan pembelajaran bagi aku secara pribadi, dan syukur ada gunanya bagi orang lain, tetapi karena blog ini bisa dilihat siapa saja, jadi yach mohon maaf apabila ada kesalahan.

Langsung saja ke penjelasan perihal postingan ini, dimana prosesnya adalah melakukan copy data sheet 1, dari semua file excel di folder yang telah ditentukan, dan melakukan paste value pada sheet baru.

Sedangkan untuk kodenya adalah :
Sub copy_multifile_difolder()
Dim foldr As String
Dim nwb As Workbook
Dim lwb As Workbook
Dim nws As Worksheet
Dim ws As Worksheet
Dim fileku As String
Dim rngku As Range
Dim rnum As Long

foldr = ThisWorkbook.Path & "\fileku\" 'kondisi foldr sebagai alamat folder fileku
Set nwb = Workbooks.Add(1) 'tambah sheet
Set nws = nwb.ActiveSheet 'sheet baru menjadi aktif
Set ws = Sheets(1) 'setting ws sebagai sheet 1

'kondisi jika dibelakang folder tidak ada tanda "\"
If Right(foldr, 1) <> "\" Then
foldr = foldr & "\"
End If

'kondisi jika tidak ada file di folder fileku
fileku = Dir(foldr & "*.xl*")
If fileku = "" Then
MsgBox "tidak ada file excel"
Exit Sub
End If

Do Until fileku = ""
If foldr <> ThisWorkbook.Path Or fileku <> ThisWorkbook.Name Then
Set lwb = Workbooks.Open(Filename:=foldr & fileku) 
'kondisi untuk setiap sheet 1
For Each ws In lwb.Worksheets
'setting range yang akan di copy
Set rngku = ws.Range("A2", ws.Cells(ws.UsedRange.Row + ws.UsedRange.Rows.Count, ws.UsedRange.Column + ws.UsedRange.Columns.Count))
'membuat judul
If rnum = 0 Then
nws.Range("A1", nws.Cells(1, rngku.Columns.Count)).Value = ws.Range("A1", ws.Cells(1, rngku.Columns.Count)).Value
rnum = 1
End If
'copy data dari file sumber ke sheet baru
rngku.Copy
nws.Range("A" & rnum + 1).Resize(rngku.Rows.Count, rngku.Columns.Count).PasteSpecial xlPasteValues
rnum = rnum + rngku.Rows.Count - 1
Next
lwb.Close False
End If
fileku = Dir() 'setting nama file menjadi variable
Loop

nwb.Sheets(1).Select
Application.EnableEvents = True
Application.ScreenUpdating = True

'membersihkan memory
Set nwb = Nothing
Set nws = Nothing
Set ws = Nothing
Set lwb = Nothing
Set rngku = Nothing
End Sub


Demikianlah sehingga postingan ini berakhir, mohon informasinya apabila ada kesalahan.
Dan sekali lagi file bisa langsung di Download disini.

12 comments:

Anonim

21 Jul 2010, 09.44.00
Ada pertanyaan, bagaimana kalau data yang di copy tidak termasuk data yang di hidden baik kolom maupun row ?
karsono

21 Jul 2010, 10.00.00
Caranya cari kode makro :

rngku.Copy

kemudian ganti dengan kode di bawah ini :

rngku.SpecialCells(xlCellTypeVisible).Copy
Anonim

2 Nov 2010, 07.39.00
saya punya pertanyaan mas..... aku punya workbook A dan workbook B. Workbook A sebagai sumber data. gimana caranya ketika saya buka workbook B maka semua data di workbook A akan terisi otomatis. makasih atas penjelasannya
karsono

4 Nov 2010, 12.24.00
Aku belum mudeng pertanyaannya, maklum rada dol...

Tetapi kalau tidak salah, Workbook A sebagai sumber data, akan dipindah secara otomatis apabila Workbook B di buka.

Kalau maksudnya seperti itu... maka bikin kode makro seperti dibawah ini di jendela MODULE VBA Macro di workbook_B.

Sub Copy_Data()
Workbooks.Open Filename:="C:\Documents and Settings\karsono\My Documents\workbook_A.xls" 'tempat file workbook_A
With Worksheets("Sheet1")'melakukan copy data yang ada di workbook_A sheet1
Intersect(.UsedRange, .Range("A2", .Cells(Rows.Count, Columns.Count))).Copy
End With
'mengaktifkan workbook_B dan paste hasil copy data dari workbook_A

ThisWorkbook.Activate
With Worksheets("Sheet1")
Range("A1").PasteSpecial
Range("A1").Select
End With

Workbooks("workbook_A.xls").Close savechanges:=False 'menutup workbook_A tanpa di simpen

End Sub


selanjutnya pada jendel Macro ThisWorkbook, masukkan kode berikut :

Private Sub Workbook_Open()
Call Copy_Data 'memanggil kode makro copy_data ketika workbook_B dibuka
End Sub


apakah begitu...?
Anonim

4 Feb 2011, 13.16.00
Mas tolong dong... saya punya data di sheet1 anggap saja cel a1 ani, a2 budi, a3 cica, a4 dodi, a5 ani, a6 cica, a7 budi, dst....

bagimana caranya di sheet2 muncul ani saja, sheet3 muncul budi saja (tersortir)secara otomatis...

Terima kasih banyak
karsono

4 Feb 2011, 14.29.00
sistemnya hampir sama dengan yang ada di postingan ini Auto Copy Filter di excel
mybook

25 Feb 2017, 18.00.00
Mas Karsono, boleh gak kalau aku requst dibuatkan form buat biodata,
bole minta nomor WA
Unknown

23 Jun 2017, 10.12.00
Boleh Minta tlg ya Mas Karsono,
begini Mas..

bagaimana kode macro input data kesamping...??

Misalnya di Kolom A "Daftar nama" dan di Kolom B dan seterusnya adalah data Bulan pembayaran.
Terimakasih sebelumnya Mas..
Unknown

25 Okt 2017, 17.54.00
mas karsono..klo mw mengatur batas copynya sampe berapa kolom yg mau di tampilkan bagaimana ya?
Ambo

28 Jan 2018, 14.06.00
Mas @karsono, pada "Set rngku = ws.Range("A2"," jika range sudah baku sheet Data F4 : M25, bagaimana rumusannya...? Terimakasih
andreas

16 Jul 2018, 15.13.00
mantap nih bang tutorialnya, terimakasih
solder uap
yoga

11 Sep 2019, 10.20.00
mas..klo mau mengambil isi dari sheet tertentu di excel tapi dalam satu folder bagaimana ya macro nya?

Posting Komentar