Dosya birleştirirken, birleştirilen dosyaların adını sayfalara verme

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Klasörde bulunan dosyaların adları ile içindeki tek sayfanın adı aynı. Kod içindeki makro, içinde bulunduğu excele bu dosyaları sayfa sayfa ekliyor, sorunsuz, ama resen Sayfa1, Sayfa2, ... gibi isimler vererek. Nasıl bir ekleme yapılmalı ki, bunların yerine dosyaların adlarını sayfa adı olarak versin. (Dosya adları A00010, A02041, ... gibi)

Sub buklasordekiexceldosyalarınıBirleştir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yol = ThisWorkbook.Path
ad = ThisWorkbook.Name
ayrac = Application.PathSeparator
dosya = Dir(yol & ayrac & "*.xlsx")
      Do While dosya <> ""
      If dosya <> ad Then
        Workbooks.Open yol & ayrac & dosya
        Dim sayfa As Worksheet
        For Each sayfa In Workbooks(dosya).Worksheets
        sadi = sayfa.Name
        Workbooks(ad).Activate
        Workbooks(ad).Sheets.Add After:=Sheets(Sheets.Count)
        Workbooks(dosya).Worksheets(sadi).Range("A:Z").Copy
        Workbooks(ad).Sheets(Sheets.Count).Paste
        Next
      Workbooks(dosya).Close
      End If
        dosya = Dir()
      Loop
Application.ScreenUpdating = False
Application.DisplayAlerts = True
End Sub

Saygılarımla

 

[Ömer]

Merhaba,

Workbooks(ad).Sheets(Sheets.Count).Paste

satırından sonra aşağıdaki satırı ilave ederek deneyin.

ActiveSheet.Name = sadi

.

 

[Tevfik_Kursun]

Sayın Ömer Hocam,
İlginize çok teşekkür ederim, deneme doğru sonuç verdi.
Bu dosyalar, bu makronun içinde bulunduğu dosyanın bulunduğu klasörünün altında Excel adlı dosyada olsa nasıl bir ekleme ister?
Saygılarımla

 

[Ömer]

Tam olarak istediğinizi anlayamadım.

yol = ThisWorkbook.Path

yol tanımından dosya yolunu düzenleyebilirsiniz.

 

[Tevfik_Kursun]

Sayın Ömer Hocam,
yol = ThisWorkbook.Path & "\Excel" olarak denedim. Az önce hata verdi ama şimdi çalıştı. Belki bir noktayı kaçırmışım.
Size ve tüm arkadaşlara çok teşekkür ederim.
Saygılarımla