Sayfaları İçe Aktarma

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:

1. İ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

2. Ekran güncellemeyi ve uyarıları görüntülemeyi kapatın.

Application.ScreenUpdating = False
Application.DisplayAlerts = False

3. 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??")

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.

4. 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

Aşağıdaki kod satırlarını (5, 6, 7 ve 8'de) Do While Loop döngüsü içine ekleyin.

5. Ç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)

6. 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

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.

7. Excel dosyasını kapatın.

Workbooks(dosyaAdi).Close

8. 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()

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.

9. 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

10. 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

Paylaş: