Kapalı dosya. Kitabın ismini sayfalara ekleyecek kod.

[Bora K]

Merhabalar
iyi akşamlar.

Yazılacak kod ile
Kitabın kendi adını sayfalara ilave edeceğiz.
Belirli sayfaları bu işlemden muaf tutacağız.
Muaf tutulacak sayfalar : "aa" , "bb" ,"cc" ve "dd"

Örnek olarak:
"Çalışma" adlı bir kitabın
Kod sonrası sayfa isimleri aşağıdaki gibi olacak.

Çalışma - Sayfa1
Çalışma - Sayfa2
Çalışma - Sayfa3


Değerli uzmanlarımızın yardımlarını bekliyorum.
Saygılarımla.

 

[Korhan Ayhan]

Bütün dosyalarınızı aynı klasör altına aldıktan sonra aşağıdaki kodu deneyin. Kodun bulunduğu dosyada işlem yapılmaz.

Sub Kitabin_Adini_Sayfalara_Ekle()
    Dim Dosya_Yolu As String
    Dim K1 As Workbook
    Dim Sayfa As Worksheet
    
    Application.ScreenUpdating = False
    
    Dosya_Yolu = ThisWorkbook.Path & "\"
    
    Dosya = Dir(Dosya_Yolu & "*.xls*")
    
    On Error Resume Next
    
    While Dosya <> ""
        If Dosya <> ThisWorkbook.Name Then
            Set K1 = Workbooks.Open(Dosya_Yolu & Dosya)
            For Each Sayfa In K1.Worksheets
                Select Case Sayfa.Name
                    Case "aa", "bb", "cc", "dd"
                    Case Else
                        Sayfa.Name = Split(Dosya, ".")(0) & " - " & Sayfa.Name
                End Select
            Next
            K1.Close 1
        End If
        Dosya = Dir
    Wend
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Bora K]

Ellerinize sağlık.
Çok çok teşekkür ediyorum
Korhan Hocam.

Saygılarımla.