Catetan

COPY MULTIFILE EXCEL DI SATU FOLDER 9


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.

9 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
kamal bayu

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

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?

Posting Komentar