Aşağıda, diğer Excel dosyalarından sayfaları tek bir Excel dosyasında içeri aktaran bir Excel VBA programına bakacağız.
“C:\excel\” klasörü içine kitap1.xlsx ve kitap2.xlsx dosyaları yaratın.
Durum:
Komut düğmesine aşağıdaki kod satırlarını ekleyin:
- İlk olarak, String türünde iki değişken, bir Çalışma Sayfası nesnesi ve bir Tamsayı türünde bir değişken tanımlıyoruz.
Dim dizin As String, dosyaAdi As String, sayfa As Worksheet, toplam As Integer
Code language: VB.NET (vbnet)
- Ekran güncellemeyi ve uyarıları görüntülemeyi kapatın.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Code language: VB.NET (vbnet)
- Değişken dizini başlatın. Dizinde yer alan ilk *.xl?? dosyasını bulmak için Dir işlevini kullanırız.
dizin = "c:\excel\"
dosyaAdi = Dir(dizin & "*.xl??")
Code language: VB.NET (vbnet)
Not: Dir işlevi, tüm farklı Excel dosyalarını aramak için birden çok karakter (*) ve tek karakter (?) joker karakter kullanımını destekler.
- dosyaAdi değişkeni artık dizinde bulunan ilk Excel dosyasının adını tutar. Do While Döngüsü ekleyin.
Do While dosyaAdi <> ""
Loop
Code language: VB.NET (vbnet)
Aşağıdaki kod satırlarını (5, 6, 7 ve 8’de) Do While Loop döngüsü içine ekleyin.
- Çalışma sayfalarını kapalı Excel dosyalarından kopyalamanın basit bir yolu yoktur. Bu nedenle Excel dosyasını açıyoruz.
Workbooks.Open (dizin & dosyaAdi)
Code language: VB.NET (vbnet)
- Sayfaları Excel dosyasından kitap1.xlsm’ye aktarın.
For Each sayfa In Workbooks(dosyaAdi).Worksheets
toplam = Workbooks("makro.xlsm").Worksheets.Count
Workbooks(dosyaAdi).Worksheets(sayfa.Name).Copy _
after:=Workbooks("makro.xlsm").Worksheets(toplam)
Next sayfa
Code language: VB.NET (vbnet)
Açıklama: toplam değişkeni, makro.xlsm dosyasının toplam çalışma sayfası sayısını takip eder. Her çalışma sayfasını kopyalamak ve makro.xlsm’nin son çalışma sayfasından sonra yapıştırmak için Çalışma Sayfası nesnesinin Kopyala yöntemini kullanırız.
- Excel dosyasını kapatın.
Workbooks(dosyaAdi).Close
Code language: VB.NET (vbnet)
- Dir işlevi özel bir işlevdir. Diğer Excel dosyalarını almak için Dir işlevini tekrar argüman olmadan kullanabilirsiniz.
dosyaAdi = Dir()
Code language: VB.NET (vbnet)
Not: Daha fazla dosya adı eşleşmediğinde, Dir işlevi sıfır uzunluklu bir dize (“”) döndürür. Sonuç olarak, Excel VBA Do while döngüsünden çıkar.
- Ekran güncellemeyi ve uyarıları tekrar görüntülemeyi açın (döngünün dışında, loop komutundan sonraki satıra).
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Code language: VB.NET (vbnet)
- Programı test edin.
Sonuç:
Not: Excel aynı ada sahip sayfaya rastlarsa sayfayı yeniden adlandırır.
Tüm kodlar:
Private Sub CommandButton1_Click()
Dim dizin As String, dosyaAdi As String, sayfa As Worksheet, toplam As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
dizin = "c:\excel\"
dosyaAdi = Dir(dizin & "*.xl??")
Do While dosyaAdi <> ""
Workbooks.Open (dizin & dosyaAdi)
For Each sayfa In Workbooks(dosyaAdi).Worksheets
toplam = Workbooks("makro.xlsm").Worksheets.Count
Workbooks(dosyaAdi).Worksheets(sayfa.Name).Copy _
after:=Workbooks("makro.xlsm").Worksheets(toplam)
Next sayfa
Workbooks(dosyaAdi).Close
dosyaAdi = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Code language: VB.NET (vbnet)