Birden Fazla Excel Dosyasını Bir Excel Dosyasında Sayfalar Halinde Birleştirmek
Bir klasör içinde bulunan birden fazla excel dosyası var. Bu excel dosyalarının ilk sayfasında veri mevcut. Burada amacımız tüm excel dosyalarını sayfa yapılarınıda bozmadan tek bir excel dosyası içerisinde sayfalara taşımak. Benim için dosya isimlerinin önemi olmadığı için ben yeniden Sayfa1 Sayfa2 şeklinde isimlendirerek sayfalar oluşturdum. Ama istenirse excel dosya isimleri yeni oluşturulan excel dosyasında sayfa ismi olabilir. Vba kodumuz aşağıdaki gibidir.
Sub Birlestir()
Dim klasor_yolu As String
Dim birlesmis_veri As Workbook
Dim dosya As String
Dim acilan_dosya As Workbook
Dim ws As Worksheet
Dim yeni_sayfa As Worksheet
Dim sayfa_sirasi As Integer
' Birleştireceğiniz dosyaların bulunduğu klasör yolunu belirtin
klasor_yolu = "C:\Users\fatih\Desktop\excel"
' Yeni birleştirilmiş veri dosyasını oluşturun
Set birlesmis_veri = Workbooks.Add
' Sayfa sırasını başlatın
sayfa_sirasi = 2
' Tüm Excel dosyalarının listesini alın
dosya = Dir(klasor_yolu & "*.xlsx")
' Her bir Excel dosyasını açın ve birleştirin
Do While dosya <> ""
' Excel dosyasını açın
Set acilan_dosya = Workbooks.Open(klasor_yolu & dosya)
' İlk sayfayı alın ve yeni bir sayfaya yapıştırın
Set ws = acilan_dosya.Sheets(1)
ws.Copy After:=birlesmis_veri.Sheets(birlesmis_veri.Sheets.Count)
Set yeni_sayfa = birlesmis_veri.Sheets(birlesmis_veri.Sheets.Count)
' Sayfa adını güncelleyin
yeni_sayfa.Name = "Sayfa" & sayfa_sirasi
' Sayfa sırasını bir artırın
sayfa_sirasi = sayfa_sirasi + 1
' Sonraki Excel dosyasını alın
acilan_dosya.Close
dosya = Dir
Loop
' Birleştirilmiş veri dosyasını kaydedin
birlesmis_veri.SaveAs "C:\Users\fatih\Desktop\excel\birlesmis_excel.xlsx"
' Birleştirilmiş veri dosyasını kapatın
birlesmis_veri.Close False
MsgBox "Excel dosyaları başarıyla birleştirildi!", vbInformation
End SubBu kod sayende artık yolunu belirttiğiniz klasör içindeki excel dosyaları “birlesmis_excel.xlsx” excel dosyası içerisinde birleşti.