mang ujang or ujanx
mungkin ceritanya ingin coba ngegabungin banyak wokbuk in a folder ke
satu wokbuk
dalam contoh ini ratusan xls file yang akan di buka di taruh di folder
yg diberinama subdirectory
pada saat penggabungan data jika telah melewati batas row 65536 maka
akan dibuat sheet baru dan mengcopy data dimulai dari A2 bukan dari
A1, karena A1 biasanya sbg header atas file yang berstruktur sama
tapi mohon maaf koneksi lagi lemot banget jadi ga bisa attached sample
wokbuknya.. (soalnya lagi di gunung nehhh mana hujan.. becek.. ga ada
ojek..)
Sub CombineSheets()
Dim Path As String,FileName As String
Dim tWB As Workbook, tWS As Worksheet, mWB
As Workbook
Dim aWS As Worksheet
Dim RowCount As Long
Dim uRange As Range
Path = ThisWorkbook.Path & "\subdirectory\"
Application.EnableEvents = False
Application.ScreenUpdating = False
Set mWB = Workbooks.Add(1)
Set aWS = mWB.ActiveSheet
If Right(Path, 1) <> Application.PathSeparator Then
Path = Path & Application.PathSeparator
End If
FileName = Dir(Path & "*.xls", vbNormal)
Do Until FileName = ""
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=Path & FileName)
For Each tWS In tWB.Worksheets
Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row +
tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1))
If RowCount + uRange.Rows.Count > 65536 Then
aWS.Columns.AutoFit
Set aWS = mWB.Sheets.Add(After:=aWS)
RowCount = 0
End If
If RowCount = 0 Then
aWS.Range("A1", aWS.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value
RowCount = 1
End If
aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count,
uRange.Columns.Count).Value _
= uRange.Value
RowCount = RowCount + uRange.Rows.Count
Next
tWB.Close False
End If
FileName = Dir()
Loop
aWS.Columns.AutoFit
mWB.Sheets(1).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Set tWB = Nothing
Set tWS = Nothing
Set mWB = Nothing
Set aWS = Nothing
Set uRange = Nothing
End Sub
2009/2/27, nm kid <[email protected]>:
> Sdr Sandy Warsito,
>
> Langkah pertama adalah mendapatkan nama-nama workbook tersebut. Hal ini bisa
> dilakukan menggunakan Application.FileSearch (tapi tidak berfungsi pada
> xl2007), atau dengan scripting FSO (tetapi vba harus direferensikan ke
> Scripting Runtime Library, atau menggunakan WinAPI yang memanfaatkan Kernel,
> dan masih banyak lagi.
>
> Pada file terlampir, saya gunakan WinApi, yang memang agak ribet jika tidak
> terbiasa, karena harus menyesuaikan argumen fungsi dengan fungsi WinAPI
> (waduh, gimana njelasinnya ya.. kira-kira seperti itulah)
>
> Tetapi, bentukannya baku dan relatif lebih cepat, karena metode ini juga
> digunakan oleh Windows dalam kegiatan yang berhubungan dengan file.
>
> Daftar workbook bisa disimpan dalam bentuk array variabel ataupun langsung
> ke sheet. Saya gunakan langsung ke sheet aktif tempat data berkumpul
> nantinya.
>
> Langkah kedua adalah membuka masing-masing workbook dari daftar workbook
> tadi, yang disertai pembacaan nilai pada cell A1 di setiap worksheetnya,
> atau di worksheet tertentu (butuh sedikit perubahan saja), lalu menulis
> nilai tersebut di workbook awal sheet tempat berkumpul data, diikuti
> penutupan workbook.
>
> Hal ini akan di loop hingga seluruh workbook.
>
> Semoga bermanfaat,
> kid.
>
>
> 2009/2/26 Sandy Warsito <[email protected]>
>
>> Mohon bantuannya,
>>
>> Bagaimana kodenya untuk membuka satu-satu sekitar 100 an workbooks di satu
>> folder lalu mencopy value cel A1 di tiap-tiap workbook itu ke satu
>> workbook.
>>
>> .
>>
>>
>>
>
