Excel çalışma kitabı adını değiştirme

[Selcuk1903]

S.a arkadaşlar Elimde a hücresinde a1den a1000 e kadar konu başlığı var ve 1000 tane boş excel çalışma kitabı var. Ben olursa a1 hücresinde bulunan konu başlığından başlayarak 1000 tane boş excel çalışma kitabının adını değiştirmek istiyorum formül veya makro ile yapabilirmiyiz...

Örneğin : a1 hücresinde bulunan konu başlığına tıkladığım zaman a1 hücresinde bulunan konu başlığı ile elimde bulunan boş excel çalışma kitabının adını a1 de bulunan konu başlığı ile değiştirsin kolay gelsin

 

[Selcuk1903]

Yardımcı olabilecek var mı

 

[Selcuk1903]

Yardımcı olabilecek bi arkadaş var mı kusura bakmayın rahatsız ediyorum

 

[ÖmerFaruk]

1. Boş/dolu farketmez, ismi değişecek olan Kitaplar açık mı yoksa hepsi aynı klasör altında kapalı durumda mı?
2. A1 e tıklayınca 1000 dosyanında adı da A1 olarak mı değişecek yoksa A1-A1000 arasındaki isimlerle mi değişecek?

 

[Selcuk1903]

1. Boş/dolu farketmez, ismi değişecek olan Kitaplar açık mı yoksa hepsi aynı klasör altında kapalı durumda mı?
2. A1 e tıklayınca 1000 dosyanında adı da A1 olarak mı değişecek yoksa A1-A1000 arasındaki isimlerle mi değişecek?

1. Hepsi klasör içinde kapalı durumda hocam
2. A1 e tıklayınca 1000 dosyanın adı a1 olarak değişmeyecek a1 - a1000 arasındaki isimler ile değişecek


Örneğin : a1 hücresinde bulunan konu başlığına tıkladığım zaman 1 klasör içinde hepsi kapalı olan excel çalışma kitabından birine a1 deki konu başlığı ismi ile değiştirsin, a2 ye tıkladığım zaman 1 klasör içinde hepsi kapalı olan excel çalışma kitabından birine a2 deki konu başlığı ismi ile değiştirsin.....

İnşallah anlatabildim hocam

 

[ÖmerFaruk]

A1 e tıkladım 1000 dosyadan herhangi birine isim olarak A1 de yazılan veriyi verdi.
Sonra A2 ye tıkladım. 1000 dosyadan herhangi isim olarak A2 de yazılan veriyi verdi.
Bu herhangi dosya aynı dosya olabilir mi?
Bana olmayacak gibi geliyor.
Sanki şunu mu istiyorsunuz?
A1:A1000 aralığından herhangi birine tıkladığınızda
Klasörün altındaki 1000 dosyadan mevcuttaki adı A1:A1000 aralığındaki konu başlıklarıyla aynı olmayan herhangi bir dosyaya tıklanan hücredeki konu başlığı isim olarak verilecek.

 

[Selcuk1903]

A1 e tıkladım 1000 dosyadan herhangi birine isim olarak A1 de yazılan veriyi verdi.
Sonra A2 ye tıkladım. 1000 dosyadan herhangi isim olarak A2 de yazılan veriyi verdi.
Bu herhangi dosya aynı dosya olabilir mi?
Bana olmayacak gibi geliyor.
Sanki şunu mu istiyorsunuz?
A1:A1000 aralığından herhangi birine tıkladığınızda
Klasörün altındaki 1000 dosyadan mevcuttaki adı A1:A1000 aralığındaki konu başlıklarıyla aynı olmayan herhangi bir dosyaya tıklanan hücredeki konu başlığı isim olarak verilecek.

Evet hocam dediğiniz gibi

 

[Selcuk1903]

A1 e tıkladım 1000 dosyadan herhangi birine isim olarak A1 de yazılan veriyi verdi.
Sonra A2 ye tıkladım. 1000 dosyadan herhangi isim olarak A2 de yazılan veriyi verdi.
Bu herhangi dosya aynı dosya olabilir mi?
Bana olmayacak gibi geliyor.
Sanki şunu mu istiyorsunuz?
A1:A1000 aralığından herhangi birine tıkladığınızda
Klasörün altındaki 1000 dosyadan mevcuttaki adı A1:A1000 aralığındaki konu başlıklarıyla aynı olmayan herhangi bir dosyaya tıklanan hücredeki konu başlığı isim olarak verilecek.

Günaydın hocam benim bir klasör içinde 1000 tane yeni microsoft excel çalışma sayfası diye dosyam var 1000 tane kopyaladım sizinde dediğiniz gibi a1 ile a1000 arasındaki konu başlığının hangisine tıklarsam bana 1000 tane yeni microsoft excel çalışma sayfasından her hangi birinin adını değiştirmesini istiyorum

 

[Selcuk1903]

Arkadaşlar var mı yardımcı olabilecek tek tek yapmak çok zor

 

[Selcuk1903]

Yardım lütfen anlayan bi hocamız yol gösterebilir mi

 

[ÖmerFaruk]

Umarım yapabilirsiniz.

Yeni isimleriniz dosyanızın Sayfa1 sayfasında, A1:A1000 aralığında olacak
İsmi değişecekler dosyalar, ana dosyanızın bulunduğu klasörün altında İsmiDeğişecekler isimli klasör altında olacak

Dosyanızın Sayfa1 kod sayfasına aşağıdaki kodu yapıştırın

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A1:A1000")) Is Nothing Then Exit Sub
    Module1.DosyaİsmiYenile
    Cancel = True
End Sub

Dosyanıza Module1 ekleyin. Module1 kod sayfasına aşağıdaki kodu yapıştırın.
Sonrasıda Sayfa1 A1:A1000 aralığında çift tıkladığınızda İsmiDeğişecekler klasörünün altındaki ismi değişmemiş olan dosyanın adı değişecektir.

Sub DosyaİsmiYenile()
Dim Klasor As String, i%, NameOld As String, NameNew As String
Dim Dict1 As Object, Dosyalar As Object, Dosya As Object
    
    Set Dict1 = CreateObject("Scripting.Dictionary")
    Set Dict2 = CreateObject("Scripting.Dictionary")
    Veri = Worksheets("Sayfa1").Range("A1:A1000").Value
    
    For i = 1 To 1000
        If Not Dict1.Exists(Veri(i, 1)) Then
            Dict1.Add Veri(i, 1), i
        End If
    Next i

    Klasor = ThisWorkbook.Path & Application.PathSeparator & "İsmiDeğişecekler"
    Set Dosyalar = CreateObject("Scripting.FileSystemObject")
    For Each Dosya In Dosyalar.GetFolder(Klasor).Files
        If Not Dict1.Exists(Dosyalar.GetBaseName(Dosya.Name)) Then
            DosyaTipi = "." & Dosyalar.GetExtensionName(Dosya)
            NameOld = Klasor & Application.PathSeparator & Dosyalar.GetBaseName(Dosya.Name) & DosyaTipi
            NameNew = Klasor & Application.PathSeparator & ActiveCell.Value & DosyaTipi
            Name NameOld As NameNew
            Exit For
        End If
    Next
    Set Dict1 = Nothing: Erase Veri: Set Dosyalar = Nothing: Klasor = "": NameOld = "": NameNew = "": i = Empty
End Sub

 

[Selcuk1903]

Umarım yapabilirsiniz.

Yeni isimleriniz dosyanızın Sayfa1 sayfasında, A1:A1000 aralığında olacak
İsmi değişecekler dosyalar, ana dosyanızın bulunduğu klasörün altında İsmiDeğişecekler isimli klasör altında olacak

Dosyanızın Sayfa1 kod sayfasına aşağıdaki kodu yapıştırın

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A1:A1000")) Is Nothing Then Exit Sub
    Module1.DosyaİsmiYenile
    Cancel = True
End Sub

Dosyanıza Module1 ekleyin. Module1 kod sayfasına aşağıdaki kodu yapıştırın.
Sonrasıda Sayfa1 A1:A1000 aralığında çift tıkladığınızda İsmiDeğişecekler klasörünün altındaki ismi değişmemiş olan dosyanın adı değişecektir.

Sub DosyaİsmiYenile()
Dim Klasor As String, i%, NameOld As String, NameNew As String
Dim Dict1 As Object, Dosyalar As Object, Dosya As Object
   
    Set Dict1 = CreateObject("Scripting.Dictionary")
    Set Dict2 = CreateObject("Scripting.Dictionary")
    Veri = Worksheets("Sayfa1").Range("A1:A1000").Value
   
    For i = 1 To 1000
        If Not Dict1.Exists(Veri(i, 1)) Then
            Dict1.Add Veri(i, 1), i
        End If
    Next i

    Klasor = ThisWorkbook.Path & Application.PathSeparator & "İsmiDeğişecekler"
    Set Dosyalar = CreateObject("Scripting.FileSystemObject")
    For Each Dosya In Dosyalar.GetFolder(Klasor).Files
        If Not Dict1.Exists(Dosyalar.GetBaseName(Dosya.Name)) Then
            DosyaTipi = "." & Dosyalar.GetExtensionName(Dosya)
            NameOld = Klasor & Application.PathSeparator & Dosyalar.GetBaseName(Dosya.Name) & DosyaTipi
            NameNew = Klasor & Application.PathSeparator & ActiveCell.Value & DosyaTipi
            Name NameOld As NameNew
            Exit For
        End If
    Next
    Set Dict1 = Nothing: Erase Veri: Set Dosyalar = Nothing: Klasor = "": NameOld = "": NameNew = "": i = Empty
End Sub

Çok teşekkür ederim allah razı olsun hocam çok sağolasın ne desem az size hayırlı akşamlar

 

[ÖmerFaruk]

Denediniz ve tamam mıdır?

 

[Selcuk1903]

Denediniz ve tamam mıdır?

Denedim

Denediniz ve tamam mıdır?

Denedim hocam elinize sağlık büyük bi dertten kurtardınız kusursuz çalışıyor kolay gelsin

 

[akmes]

Umarım yapabilirsiniz.

Yeni isimleriniz dosyanızın Sayfa1 sayfasında, A1:A1000 aralığında olacak
İsmi değişecekler dosyalar, ana dosyanızın bulunduğu klasörün altında İsmiDeğişecekler isimli klasör altında olacak

Dosyanızın Sayfa1 kod sayfasına aşağıdaki kodu yapıştırın

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A1:A1000")) Is Nothing Then Exit Sub
    Module1.DosyaİsmiYenile
    Cancel = True
End Sub

Dosyanıza Module1 ekleyin. Module1 kod sayfasına aşağıdaki kodu yapıştırın.
Sonrasıda Sayfa1 A1:A1000 aralığında çift tıkladığınızda İsmiDeğişecekler klasörünün altındaki ismi değişmemiş olan dosyanın adı değişecektir.

Sub DosyaİsmiYenile()
Dim Klasor As String, i%, NameOld As String, NameNew As String
Dim Dict1 As Object, Dosyalar As Object, Dosya As Object
  
    Set Dict1 = CreateObject("Scripting.Dictionary")
    Set Dict2 = CreateObject("Scripting.Dictionary")
    Veri = Worksheets("Sayfa1").Range("A1:A1000").Value
  
    For i = 1 To 1000
        If Not Dict1.Exists(Veri(i, 1)) Then
            Dict1.Add Veri(i, 1), i
        End If
    Next i

    Klasor = ThisWorkbook.Path & Application.PathSeparator & "İsmiDeğişecekler"
    Set Dosyalar = CreateObject("Scripting.FileSystemObject")
    For Each Dosya In Dosyalar.GetFolder(Klasor).Files
        If Not Dict1.Exists(Dosyalar.GetBaseName(Dosya.Name)) Then
            DosyaTipi = "." & Dosyalar.GetExtensionName(Dosya)
            NameOld = Klasor & Application.PathSeparator & Dosyalar.GetBaseName(Dosya.Name) & DosyaTipi
            NameNew = Klasor & Application.PathSeparator & ActiveCell.Value & DosyaTipi
            Name NameOld As NameNew
            Exit For
        End If
    Next
    Set Dict1 = Nothing: Erase Veri: Set Dosyalar = Nothing: Klasor = "": NameOld = "": NameNew = "": i = Empty
End Sub

Merhaba, Elinize sağlık çok güzel bir çalışma olmuş, bu makro gibi belirtilen klasörün içerisine A1:A30 arasın da yazılı tüm tarihlere(yani 1 aylık) ait dosyaları bir anda açabilecek hale gelebilir mi? Yardımlarınız için şimdiden teşekkür ederim.