Kapalı klasörde isim değiştirme

[sezer32]

klasör içinde 200 excel dosyası var hepsinin çalışma sayfası Sheet1 olarak kayıtlı bu Sheet1 i değiştrebilirmiyiz mesela 2011,6 gibi

 

[Korhan Ayhan]

Merhaba,

Ben sorunuzu klasör altındaki excel dosyalarının adını değiştirmek olarak anladım. Eğer istediğiniz buysa aşağıdaki kodu kullanabilirsiniz.

Koddaki kırmızı bölüm klasörünüzün bulunduğu bölümdür. Mavi renkli bölüm ise yeni dosya adıdır. Bu bölümleri kendinize göre düzenleyin.

Option Explicit
 
Sub DOSYA_ADI_DEĞİŞTİR()
    Dim Yol As String, Uzantı As String, Dosya As String, Say As Integer
 
    On Error GoTo Son
 
[COLOR=red]    Yol = "C:\Users\Desktop\Yeni klasör\"[/COLOR]
    Uzantı = Yol & "*.xls"
 
    Dosya = Dir(Uzantı)
    Say = 1
 
    While Dosya <> ""
        Name Yol & Dosya As Yol & [COLOR=blue]"Deneme " & Say[/COLOR] & ".xls"
        Say = Say + 1
        Dosya = Dir
    Wend
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Exit Sub
 
Son:
    MsgBox "Aynı dosya adını bir defa kullanabilirsiniz !" & _
    Chr(10) & "İşleminiz iptal edilmiştir.", vbCritical
End Sub

 

[Mehmet Şahin]

Merhabalar,
sayfa isimlerini değiştirme açısından alternatif olsun.
İyi geceler.

Dim dosya_ac As Variant
Sub guncelle()
Dim wbk As Workbook
Dim ws As Worksheet

    eski = InputBox("Değişecek Sayfa Adını Girin!")
    yeni = InputBox("Yeni Sayfa Adını Girin!")
    If eski = "" Or yeni = "" Then
    MsgBox "Sayfa Adlarını Belirtmelisiniz!"
    Exit Sub
    End If

    dosya_ac = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Lütfen Dosya Seçin!")
    If TypeName(dosya_ac) = "Boolean" Then
        MsgBox "Dosya Seçimi yapılmadı!"
        Exit Sub
    End If
    Application.ScreenUpdating = False
        For i = 1 To UBound(dosya_ac)
             Set wbk = Workbooks.Open(dosya_ac(i), False, False)
                    For Each ws In wbk.Worksheets
                        If ws.Name = eski Then
                           ws.Name = yeni
                           Exit For
                        End If
                    Next ws
                    Application.DisplayAlerts = False
                    wbk.Close savechanges:=True
                    Application.DisplayAlerts = True
             Set wbk = Nothing
        Next i
      Application.ScreenUpdating = True
      MsgBox "İşlem Tamamlandı!"
End Sub

 

[sezer32]

sayın dentex teşekkür ederim verdiğiniz kod oldu büyük zahmetten kurtardınız

sayın korhan sizede ilgilendiğiniz için teşekkür ederim

iyi çalışmalar

edit : sayın dentex benim bilgim yok bu konularda bi buton gibi bişey yapabilirmisiniz verdiginiz kod için

 

[Mehmet Şahin]

Evet, bu kod bunu yapar. Siz makroyu çalıştırıp, açılan dialog kutusundan dosyaları seçiyorsunuz, değiştirmek istediğiniz dosya adını yazıp, değiştirilecek adı yazıyorsunuz ve işlem tamam!

 

[Mehmet Şahin]

Merhaba,
dosya ektedir. İyi akşamlar.

 

[halit3]

klasör içinde 200 excel dosyası var hepsinin çalışma sayfası Sheet1 olarak kayıtlı bu Sheet1 i değiştrebilirmiyiz mesela 2011,6 gibi

Alternatif kod

Dim Klasor As Object
Dim Kaynak As String
Dim eskisayfa As String
Dim yenisayfa As String

Sub klasordekisayfaisimlerinidegistir()
eskisayfa = InputBox("Var olan Sayfa adını yazınız.?", "Eski sayfa ismi", "Sheet1")
If eskisayfa = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
yenisayfa = InputBox("Değiştireceğiniz sayfa adını yazınız.?", "Yeni sayfa ismi", "deneme")
If yenisayfa = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path 'Klasor.Items.Item.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Call Liste2(Kaynak, "")
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
End Sub

Private Sub Liste2(Klasor As String, Uzanti As String)
Dim fL As Object, f As Object, Dosya As String
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).subfolders
Dim wb As Workbook
Dosya = Dir(Klasor & "\*.**" & Uzanti)
Application.ScreenUpdating = False
While Dosya <> ""
DoEvents
Application.DisplayAlerts = False
If ThisWorkbook.Name <> Dosya Then
Set wb = Workbooks.Open(Klasor & "\" & Dosya)
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name = eskisayfa Then
Sheets(Sheets(i).Name).Select
ActiveSheet.Name = yenisayfa
Exit For
End If
Next
wb.Save
wb.Close False
Application.Visible = True
End If
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
Kaynak = f.Path
Call Liste2(Kaynak, "")
sonraki:
Next
Set fL = Nothing
End Sub

 

[sezer32]

sn halit sizede teşekkür ederim birde aşağıda derdime çağre bulabilirseniz sevinirim tablo üzerinde açıklamaya çalıştım derdimi basit birşeyse kısa yoldan anlatırsanız sevinirim başka yerdede lazım

 

[halit3]

sn halit sizede teşekkür ederim birde aşağıda derdime çağre bulabilirseniz sevinirim tablo üzerinde açıklamaya çalıştım derdimi basit birşeyse kısa yoldan anlatırsanız sevinirim başka yerdede lazım

Mesajınızda sorunuzu belirtmemişsiniz sorunuzu öğrenmek için dosyanızı indirmek gerekli şimdi kota sorunu olanlar bu dosyanızı indirip bakmaz,neyse ben indirdim baktım.

Öncelikle konu bütünlüğünün bozulmaması için konu ile ilgili sorularınızı buradan sorun diğer taraftan sorunuz bu konu ile ilgili değil sizin sorunuz ad tanımlama ile ilgili, bu konuda arama yaparsanız bir sürü örnek göreceksiniz. Eğer netice alamazsanız yeni bir konu açarak başka bir başlık altında ad tanımlaması ile ilgili soru sorarsanız cevap alabilirsiniz.