• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Katılım
21 Ocak 2013
Mesajlar
331
Excel Vers. ve Dili
2003 Türkçe
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.
 

Ekli dosyalar

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.

Kod:
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
 
Ellerinize sağlık.
Çok çok teşekkür ediyorum
Korhan Hocam.

Saygılarımla.
 
Geri
Üst